Add class_for_hint function to OpenILS::Utils::Fieldmapper.
[working/Evergreen.git] / 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
143                         $$fieldmap{$fm}{links}{ $field } =
144                                 { class   => $class,
145                                   reltype => $reltype,
146                                   key     => $key,
147                                 };
148                 }
149         }
150 }
151
152 sub load_class {
153         my $class_node = shift;
154
155         # Get attributes ---------------------------------------------
156
157         my $attribute_list = $class_node->attributes();
158
159         my $fm               = get_attribute( $attribute_list, 'oils_obj:fieldmapper' );
160         $fm                  = 'Fieldmapper::' . $fm;
161         my $id               = get_attribute( $attribute_list, 'id' );
162         my $controller       = get_attribute( $attribute_list, 'controller' );
163         my $virtual          = get_attribute( $attribute_list, 'virtual' );
164         if( ! defined( $virtual ) ) {
165                 $virtual = 'false';
166         }
167         my $tablename        = get_attribute( $attribute_list, 'oils_persist:tablename' );
168         if( ! defined( $tablename ) ) {
169                 $tablename = '';
170         }
171         my $restrict_primary = get_attribute( $attribute_list, 'oils_persist:restrict_primary' );
172         my $field_safe = get_attribute( $attribute_list, 'oils_persist:field_safe' );
173
174         # Load the attributes into the Fieldmapper --------------------
175
176         $log->debug("Building Fieldmapper class for [$fm] from IDL");
177
178         $$fieldmap{$fm}{ hint }             = $id;
179         $$fieldmap{$fm}{ virtual }          = ( $virtual eq 'true' ) ? 1 : 0;
180         $$fieldmap{$fm}{ table }            = $tablename;
181         $$fieldmap{$fm}{ controller }       = [ split ' ', $controller ];
182         $$fieldmap{$fm}{ restrict_primary } = $restrict_primary;
183         $$fieldmap{$fm}{ field_safe }       = $field_safe;
184
185         # Load fields and links
186
187         for my $child ( $class_node->childNodes() ) {
188                 my $nodeName = $child->nodeName;
189                 if( $nodeName eq 'fields' ) {
190                         load_fields( $child, $fm );
191                 } elsif( $nodeName eq 'links' ) {
192                         load_links( $child, $fm );
193                 }
194         }
195 }
196
197 import();
198 sub import {
199         my $class = shift;
200         my %args = @_;
201
202         return if (keys %$fieldmap);
203         return if (!OpenSRF::System->connected && !$args{IDL});
204
205         # parse the IDL ...
206         my $parser = XML::LibXML->new();
207         my $file = $args{IDL} || OpenSRF::Utils::SettingsClient->new->config_value( 'IDL' );
208         my $fmdoc = $parser->parse_file( $file );
209         my $rootnode = $fmdoc->documentElement();
210
211         for my $child ( $rootnode->childNodes() ) {    # For each <class>
212                 my $nodeName = $child->nodeName;
213                 if( $nodeName eq 'class' ) {
214                         load_class( $child );
215                 }
216         }
217
218         #-------------------------------------------------------------------------------
219         # Now comes the evil!  Generate classes
220
221         for my $pkg ( __PACKAGE__->classes ) {
222                 (my $cdbi = $pkg) =~ s/^Fieldmapper:://o;
223
224                 eval <<"                PERL";
225                         package $pkg;
226                         use base 'Fieldmapper';
227                 PERL
228
229                 if (exists $$fieldmap{$pkg}{proto_fields}) {
230                         for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
231                                 $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
232                                 $pos++;
233                         }
234                 }
235
236                 OpenSRF::Utils::JSON->register_class_hint(
237                         hint => $pkg->json_hint,
238                         name => $pkg,
239                         type => 'array',
240                 );
241
242         }
243 }
244
245 sub new {
246         my $self = shift;
247         my $value = shift;
248         $value = [] unless (defined $value);
249         return bless $value => $self->class_name;
250 }
251
252 sub decast {
253         my $self = shift;
254         return [ @$self ];
255 }
256
257 sub DESTROY {}
258
259 sub AUTOLOAD {
260         my $obj = shift;
261         my $value = shift;
262         (my $field = $AUTOLOAD) =~ s/^.*://o;
263         my $class_name = $obj->class_name;
264
265         my $fpos = $field;
266         $fpos  =~ s/^clear_//og ;
267
268         my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position};
269
270         if ($field =~ /^clear_/o) {
271                 {       no strict 'subs';
272                         *{$obj->class_name."::$field"} = sub {
273                                 my $self = shift;
274                                 $self->[$pos] = undef;
275                                 return 1;
276                         };
277                 }
278                 return $obj->$field();
279         }
280
281         die "No field by the name $field in $class_name!"
282                 unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos));
283
284
285         {       no strict 'subs';
286                 *{$obj->class_name."::$field"} = sub {
287                         my $self = shift;
288                         my $new_val = shift;
289                         $self->[$pos] = $new_val if (defined $new_val);
290                         return $self->[$pos];
291                 };
292         }
293         return $obj->$field($value);
294 }
295
296 sub Selector {
297         my $self = shift;
298         return $$fieldmap{$self->class_name}{selector};
299 }
300
301 sub Identity {
302         my $self = shift;
303         return $$fieldmap{$self->class_name}{identity};
304 }
305
306 sub RestrictPrimary {
307         my $self = shift;
308         return $$fieldmap{$self->class_name}{restrict_primary};
309 }
310
311 sub Sequence {
312         my $self = shift;
313         return $$fieldmap{$self->class_name}{sequence};
314 }
315
316 sub Table {
317         my $self = shift;
318         return $$fieldmap{$self->class_name}{table};
319 }
320
321 sub Controller {
322         my $self = shift;
323         return $$fieldmap{$self->class_name}{controller};
324 }
325
326 sub RequiredField {
327         my $self = shift;
328         my $f = shift;
329     return undef unless ($f);
330         return $$fieldmap{$self->class_name}{fields}{$f}{required};
331 }
332
333 sub ValidateField {
334         my $self = shift;
335         my $f = shift;
336     return undef unless ($f);
337         return 1 if (!exists($$fieldmap{$self->class_name}{fields}{$f}{validate}));
338         return $self->$f =~ $$fieldmap{$self->class_name}{fields}{$f}{validate};
339 }
340
341 sub class_name {
342         my $class_name = shift;
343         return ref($class_name) || $class_name;
344 }
345
346 sub real_fields {
347         my $self = shift;
348         my $class_name = $self->class_name;
349         my $fields = $$fieldmap{$class_name}{fields};
350
351         my @f = grep {
352                         !$$fields{$_}{virtual}
353                 } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
354
355         return @f;
356 }
357
358 sub has_field {
359         my $self = shift;
360         my $field = shift;
361         my $class_name = $self->class_name;
362         return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}};
363         return 0;
364 }
365
366 sub properties {
367         my $self = shift;
368         my $class_name = $self->class_name;
369         return keys %{$$fieldmap{$class_name}{fields}};
370 }
371
372 sub to_bare_hash {
373         my $self = shift;
374
375         my %hash = ();
376         for my $f ($self->properties) {
377                 my $val = $self->$f;
378                 $hash{$f} = $val;
379         }
380
381         return \%hash;
382 }
383
384 sub clone {
385         my $self = shift;
386         return $self->new( [@$self] );
387 }
388
389 sub api_level {
390         my $self = shift;
391         return $fieldmap->{$self->class_name}->{api_level};
392 }
393
394 sub cdbi {
395         my $self = shift;
396         return $fieldmap->{$self->class_name}->{cdbi};
397 }
398
399 sub is_virtual {
400         my $self = shift;
401         my $field = shift;
402         return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field);
403         return $fieldmap->{$self->class_name}->{virtual};
404 }
405
406 sub is_readonly {
407         my $self = shift;
408         my $field = shift;
409         return $fieldmap->{$self->class_name}->{readonly};
410 }
411
412 sub json_hint {
413         my $self = shift;
414         return $fieldmap->{$self->class_name}->{hint};
415 }
416
417
418 1;