4 use base 'OpenSRF::Application';
5 use OpenSRF::Utils::Logger;
6 use OpenSRF::Utils::SettingsClient;
9 my $log = 'OpenSRF::Utils::Logger';
11 use vars qw/$fieldmap $VERSION/;
15 sub publish_fieldmapper {
16 my ($self,$client,$class) = @_;
18 return $fieldmap unless (defined $class);
19 return undef unless (exists($$fieldmap{$class}));
20 return {$class => $$fieldmap{$class}};
22 __PACKAGE__->register_method(
23 api_name => 'opensrf.open-ils.system.fieldmapper',
25 method => 'publish_fieldmapper',
29 # To dump the Javascript version of the fieldmapper struct use the command:
31 # PERL5LIB=~/cvs/ILS/OpenSRF/src/perlmods/:~/cvs/ILS/Open-ILS/src/perlmods/ GEN_JS=1 perl -MOpenILS::Utils::Fieldmapper -e 'print "\n";'
33 # ... adjusted for your CVS sandbox, of course.
37 return () unless (defined $fieldmap);
38 return keys %$fieldmap;
42 return if (keys %$fieldmap);
45 my $file = OpenSRF::Utils::SettingsClient->new->config_value( 'IDL' );
46 my $idl = XMLin( $file )->{class};
47 for my $c ( keys %$idl ) {
48 next unless ($idl->{$c}{'oils_obj:fieldmapper'});
49 my $n = 'Fieldmapper::'.$idl->{$c}{'oils_obj:fieldmapper'};
51 $log->debug("Building Fieldmapper clas for [$n] from IDL");
53 $$fieldmap{$n}{hint} = $c;
54 $$fieldmap{$n}{virtual} = ($idl->{$c}{'oils_persist:virtual'} eq 'true') ? 1 : 0;
56 for my $f ( keys %{ $idl->{$c}{fields}{field} } ) {
57 $$fieldmap{$n}{fields}{$f} =
58 { virtual => ($idl->{$c}{fields}{field}{$f}{'oils_persist:virtual'} eq 'true') ? 1 : 0,
59 position => $idl->{$c}{fields}{field}{$f}{'oils_obj:array_position'}
65 #-------------------------------------------------------------------------------
66 # Now comes the evil! Generate classes
68 for my $pkg ( __PACKAGE__->classes ) {
69 (my $cdbi = $pkg) =~ s/^Fieldmapper:://o;
73 use base 'Fieldmapper';
77 for my $vfield ( qw/isnew ischanged isdeleted/ ) {
78 $$fieldmap{$pkg}{fields}{$vfield} = { position => $pos, virtual => 1 };
82 if (exists $$fieldmap{$pkg}{proto_fields}) {
83 for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
84 $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
89 JSON->register_class_hint(
90 hint => $pkg->json_hint,
101 $value = [] unless (defined $value);
102 return bless $value => $self->class_name;
115 (my $field = $AUTOLOAD) =~ s/^.*://o;
116 my $class_name = $obj->class_name;
119 $fpos =~ s/^clear_//og ;
121 my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position};
123 if ($field =~ /^clear_/o) {
125 *{$obj->class_name."::$field"} = sub {
127 $self->[$pos] = undef;
131 return $obj->$field();
134 die "No field by the name $field in $class_name!"
135 unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos));
139 *{$obj->class_name."::$field"} = sub {
142 $self->[$pos] = $new_val if (defined $new_val);
143 return $self->[$pos];
146 return $obj->$field($value);
150 my $class_name = shift;
151 return ref($class_name) || $class_name;
156 my $class_name = $self->class_name;
157 my $fields = $$fieldmap{$class_name}{fields};
160 !$$fields{$_}{virtual}
161 } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
169 my $class_name = $self->class_name;
170 return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}};
176 my $class_name = $self->class_name;
177 return keys %{$$fieldmap{$class_name}{fields}};
182 return $self->new( [@$self] );
187 return $fieldmap->{$self->class_name}->{api_level};
192 return $fieldmap->{$self->class_name}->{cdbi};
198 return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field);
199 return $fieldmap->{$self->class_name}->{virtual};
205 return $fieldmap->{$self->class_name}->{readonly};
210 return $fieldmap->{$self->class_name}->{hint};