Open-ILS/src/perlmods/lib/OpenILS/Utils/Fieldmapper.pm

   1 package Fieldmapper;
   2 use OpenSRF::Utils::JSON;
   3 use Data::Dumper;
   4 use base 'OpenSRF::Application';
   5 use OpenSRF::Utils::Logger;
   6 use OpenSRF::Utils::SettingsClient;
   7 use OpenSRF::System;
   8 use XML::LibXML;
   9
  10 my $log = 'OpenSRF::Utils::Logger';
  11
  12 use vars qw/$fieldmap $VERSION/;
  13
  14 sub publish_fieldmapper {
  15         my ($self,$client,$class) = @_;
  16
  17         return $fieldmap unless (defined $class);
  18         return undef unless (exists($$fieldmap{$class}));
  19         return {$class => $$fieldmap{$class}};
  20 }
  21 __PACKAGE__->register_method(
  22         api_name        => 'opensrf.open-ils.system.fieldmapper',
  23         api_level       => 1,
  24         method          => 'publish_fieldmapper',
  25 );
  26
  27 #
  28 # To dump the Javascript version of the fieldmapper struct use the command:
  29 #
  30 #       PERL5LIB=:~/vcs/ILS/Open-ILS/src/perlmods/lib/ GEN_JS=1 perl -MOpenILS::Utils::Fieldmapper -e 'print "\n";'
  31 #
  32 # ... adjusted for your VCS sandbox of choice, of course.
  33 #
  34
  35 sub classes {
  36         return () unless (defined $fieldmap);
  37         return keys %$fieldmap;
  38 }
  39
  40 # Find a Fieldmapper class given the json hint.
  41 sub class_for_hint {
  42     my $hint = shift;
  43     foreach (keys %$fieldmap) {
  44         return $_ if ($fieldmap->{$_}->{hint} eq $hint);
  45     }
  46     return undef;
  47 }
  48
  49 sub get_attribute {
  50         my $attr_list = shift;
  51         my $attr_name = shift;
  52
  53         my $attr = $attr_list->getNamedItem( $attr_name );
  54         if( defined( $attr ) ) {
  55                 return $attr->getValue();
  56         }
  57         return undef;
  58 }
  59
  60 sub load_fields {
  61         my $field_list = shift;
  62         my $fm = shift;
  63
  64         # Get attributes of the field list.  Since there is only one
  65         # <field> per class, these attributes logically belong to the
  66         # enclosing class, and that's where we load them.
  67
  68         my $field_attr_list = $field_list->attributes();
  69
  70         my $sequence  = get_attribute( $field_attr_list, 'oils_persist:sequence' );
  71         if( ! defined( $sequence ) ) {
  72                 $sequence = '';
  73         }
  74         my $primary   = get_attribute( $field_attr_list, 'oils_persist:primary' );
  75
  76         # Load attributes into the Fieldmapper ----------------------
  77
  78         $$fieldmap{$fm}{ sequence } = $sequence;
  79         $$fieldmap{$fm}{ identity } = $primary;
  80
  81         # Load each field -------------------------------------------
  82
  83         my $array_position = 0;
  84         for my $field ( $field_list->childNodes() ) {    # For each <field>
  85                 if( $field->nodeName eq 'field' ) {
  86
  87                         my $attribute_list = $field->attributes();
  88
  89                         my $name     = get_attribute( $attribute_list, 'name' );
  90                         next if( $name eq 'isnew' || $name eq 'ischanged' || $name eq 'isdeleted' );
  91                         my $required  = get_attribute( $attribute_list, 'oils_obj:required' );
  92                         my $validate  = get_attribute( $attribute_list, 'oils_obj:validate' );
  93                         my $virtual  = get_attribute( $attribute_list, 'oils_persist:virtual' );
  94                         if( ! defined( $virtual ) ) {
  95                                 $virtual = "false";
  96                         }
  97                         my $selector = get_attribute( $attribute_list, 'reporter:selector' );
  98
  99                         $$fieldmap{$fm}{fields}{ $name } =
 100                                 { virtual => ( $virtual eq 'true' ) ? 1 : 0,
 101                                   required => ( $required eq 'true' ) ? 1 : 0,
 102                                   position => $array_position,
 103                                 };
 104
 105                         $$fieldmap{$fm}{fields}{ $name }{validate} = qr/$validate/ if (defined($validate));
 106
 107                         # The selector attribute, if present at all, attaches to only one
 108                         # of the fields in a given class.  So if we see it, we store it at
 109                         # the level of the enclosing class.
 110
 111                         if( defined( $selector ) ) {
 112                                 $$fieldmap{$fm}{selector} = $selector;
 113                         }
 114
 115                         ++$array_position;
 116                 }
 117         }
 118
 119         # Load the standard 3 virtual fields ------------------------
 120
 121         for my $vfield ( qw/isnew ischanged isdeleted/ ) {
 122                 $$fieldmap{$fm}{fields}{ $vfield } =
 123                         { position => $array_position,
 124                           virtual => 1
 125                         };
 126                 ++$array_position;
 127         }
 128 }
 129
 130 sub load_links {
 131         my $link_list = shift;
 132         my $fm = shift;
 133
 134         for my $link ( $link_list->childNodes() ) {    # For each <link>
 135                 if( $link->nodeName eq 'link' ) {
 136                         my $attribute_list = $link->attributes();
 137
 138                         my $field   = get_attribute( $attribute_list, 'field' );
 139                         my $reltype = get_attribute( $attribute_list, 'reltype' );
 140                         my $key     = get_attribute( $attribute_list, 'key' );
 141                         my $class   = get_attribute( $attribute_list, 'class' );
 142                         my $map     = get_attribute( $attribute_list, 'map' );
 143
 144                         $$fieldmap{$fm}{links}{ $field } =
 145                                 { class   => $class,
 146                                   reltype => $reltype,
 147                                   key     => $key,
 148                                   map     => $map
 149                                 };
 150                 }
 151         }
 152 }
 153
 154 sub load_class {
 155         my $class_node = shift;
 156
 157         # Get attributes ---------------------------------------------
 158
 159         my $attribute_list = $class_node->attributes();
 160
 161         my $fm               = get_attribute( $attribute_list, 'oils_obj:fieldmapper' );
 162         $fm                  = 'Fieldmapper::' . $fm;
 163         my $id               = get_attribute( $attribute_list, 'id' );
 164         my $controller       = get_attribute( $attribute_list, 'controller' );
 165         my $virtual          = get_attribute( $attribute_list, 'virtual' );
 166         if( ! defined( $virtual ) ) {
 167                 $virtual = 'false';
 168         }
 169         my $tablename        = get_attribute( $attribute_list, 'oils_persist:tablename' );
 170         if( ! defined( $tablename ) ) {
 171                 $tablename = '';
 172         }
 173         my $restrict_primary = get_attribute( $attribute_list, 'oils_persist:restrict_primary' );
 174         my $field_safe = get_attribute( $attribute_list, 'oils_persist:field_safe' );
 175
 176         # Load the attributes into the Fieldmapper --------------------
 177
 178         $log->debug("Building Fieldmapper class for [$fm] from IDL");
 179
 180         $$fieldmap{$fm}{ hint }             = $id;
 181         $$fieldmap{$fm}{ virtual }          = ( $virtual eq 'true' ) ? 1 : 0;
 182         $$fieldmap{$fm}{ table }            = $tablename;
 183         $$fieldmap{$fm}{ controller }       = [ split ' ', $controller ];
 184         $$fieldmap{$fm}{ restrict_primary } = $restrict_primary;
 185         $$fieldmap{$fm}{ field_safe }       = $field_safe;
 186
 187         # Load fields and links
 188
 189         for my $child ( $class_node->childNodes() ) {
 190                 my $nodeName = $child->nodeName;
 191                 if( $nodeName eq 'fields' ) {
 192                         load_fields( $child, $fm );
 193                 } elsif( $nodeName eq 'links' ) {
 194                         load_links( $child, $fm );
 195                 }
 196         }
 197 }
 198
 199 import();
 200 sub import {
 201         my $class = shift;
 202         my %args = @_;
 203
 204         return if (keys %$fieldmap);
 205         return if (!OpenSRF::System->connected && !$args{IDL});
 206
 207         # parse the IDL ...
 208         my $parser = XML::LibXML->new();
 209         my $file = $args{IDL} || OpenSRF::Utils::SettingsClient->new->config_value( 'IDL' );
 210         my $fmdoc = $parser->parse_file( $file );
 211         my $rootnode = $fmdoc->documentElement();
 212
 213         for my $child ( $rootnode->childNodes() ) {    # For each <class>
 214                 my $nodeName = $child->nodeName;
 215                 if( $nodeName eq 'class' ) {
 216                         load_class( $child );
 217                 }
 218         }
 219
 220         #-------------------------------------------------------------------------------
 221         # Now comes the evil!  Generate classes
 222
 223         for my $pkg ( __PACKAGE__->classes ) {
 224                 (my $cdbi = $pkg) =~ s/^Fieldmapper:://o;
 225
 226                 eval <<"                PERL";
 227                         package $pkg;
 228                         use base 'Fieldmapper';
 229                 PERL
 230
 231                 if (exists $$fieldmap{$pkg}{proto_fields}) {
 232                         for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
 233                                 $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
 234                                 $pos++;
 235                         }
 236                 }
 237
 238                 OpenSRF::Utils::JSON->register_class_hint(
 239                         hint => $pkg->json_hint,
 240                         name => $pkg,
 241                         type => 'array',
 242                 );
 243
 244         }
 245 }
 246
 247 sub new {
 248         my $self = shift;
 249         my $value = shift;
 250         $value = [] unless (defined $value);
 251         return bless $value => $self->class_name;
 252 }
 253
 254 sub decast {
 255         my $self = shift;
 256         return [ @$self ];
 257 }
 258
 259 sub DESTROY {}
 260
 261 sub AUTOLOAD {
 262         my $obj = shift;
 263         my $value = shift;
 264         (my $field = $AUTOLOAD) =~ s/^.*://o;
 265         my $class_name = $obj->class_name;
 266
 267         my $fpos = $field;
 268         $fpos  =~ s/^clear_//og ;
 269
 270         my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position};
 271
 272         if ($field =~ /^clear_/o) {
 273                 {       no strict 'subs';
 274                         *{$obj->class_name."::$field"} = sub {
 275                                 my $self = shift;
 276                                 $self->[$pos] = undef;
 277                                 return 1;
 278                         };
 279                 }
 280                 return $obj->$field();
 281         }
 282
 283         die "No field by the name $field in $class_name!"
 284                 unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos));
 285
 286
 287         {       no strict 'subs';
 288                 *{$obj->class_name."::$field"} = sub {
 289                         my $self = shift;
 290                         my $new_val = shift;
 291                         $self->[$pos] = $new_val if (defined $new_val);
 292                         return $self->[$pos];
 293                 };
 294         }
 295         return $obj->$field($value);
 296 }
 297
 298 sub Selector {
 299         my $self = shift;
 300         return $$fieldmap{$self->class_name}{selector};
 301 }
 302
 303 sub Identity {
 304         my $self = shift;
 305         return $$fieldmap{$self->class_name}{identity};
 306 }
 307
 308 sub RestrictPrimary {
 309         my $self = shift;
 310         return $$fieldmap{$self->class_name}{restrict_primary};
 311 }
 312
 313 sub Sequence {
 314         my $self = shift;
 315         return $$fieldmap{$self->class_name}{sequence};
 316 }
 317
 318 sub Table {
 319         my $self = shift;
 320         return $$fieldmap{$self->class_name}{table};
 321 }
 322
 323 sub Controller {
 324         my $self = shift;
 325         return $$fieldmap{$self->class_name}{controller};
 326 }
 327
 328 sub RequiredField {
 329         my $self = shift;
 330         my $f = shift;
 331     return undef unless ($f);
 332         return $$fieldmap{$self->class_name}{fields}{$f}{required};
 333 }
 334
 335 sub ValidateField {
 336         my $self = shift;
 337         my $f = shift;
 338     return undef unless ($f);
 339         return 1 if (!exists($$fieldmap{$self->class_name}{fields}{$f}{validate}));
 340         return $self->$f =~ $$fieldmap{$self->class_name}{fields}{$f}{validate};
 341 }
 342
 343 sub class_name {
 344         my $class_name = shift;
 345         return ref($class_name) || $class_name;
 346 }
 347
 348 sub real_fields {
 349         my $self = shift;
 350         my $class_name = $self->class_name;
 351         my $fields = $$fieldmap{$class_name}{fields};
 352
 353         my @f = grep {
 354                         !$$fields{$_}{virtual}
 355                 } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
 356
 357         return @f;
 358 }
 359
 360 sub has_field {
 361         my $self = shift;
 362         my $field = shift;
 363         my $class_name = $self->class_name;
 364         return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}};
 365         return 0;
 366 }
 367
 368 sub properties {
 369         my $self = shift;
 370         my $class_name = $self->class_name;
 371         return keys %{$$fieldmap{$class_name}{fields}};
 372 }
 373
 374 sub to_bare_hash {
 375         my $self = shift;
 376
 377         my %hash = ();
 378         for my $f ($self->properties) {
 379                 my $val = $self->$f;
 380                 $hash{$f} = $val;
 381         }
 382
 383         return \%hash;
 384 }
 385
 386 sub clone {
 387         my $self = shift;
 388         return $self->new( [@$self] );
 389 }
 390
 391 sub api_level {
 392         my $self = shift;
 393         return $fieldmap->{$self->class_name}->{api_level};
 394 }
 395
 396 sub cdbi {
 397         my $self = shift;
 398         return $fieldmap->{$self->class_name}->{cdbi};
 399 }
 400
 401 sub is_virtual {
 402         my $self = shift;
 403         my $field = shift;
 404         return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field);
 405         return $fieldmap->{$self->class_name}->{virtual};
 406 }
 407
 408 sub is_readonly {
 409         my $self = shift;
 410         my $field = shift;
 411         return $fieldmap->{$self->class_name}->{readonly};
 412 }
 413
 414 sub json_hint {
 415         my $self = shift;
 416         return $fieldmap->{$self->class_name}->{hint};
 417 }
 418
 419
 420 1;