]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/Utils/Fieldmapper.pm
automatic generation of most "Publish" methods
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Utils / Fieldmapper.pm
1 package Fieldmapper;
2 use JSON;
3 use Data::Dumper;
4 use OpenILS::Application::Storage::CDBI;
5 use OpenILS::Application::Storage::CDBI::actor;
6 use OpenILS::Application::Storage::CDBI::biblio;
7 use OpenILS::Application::Storage::CDBI::config;
8 use OpenILS::Application::Storage::CDBI::metabib;
9
10 use vars qw/$fieldmap $VERSION/;
11
12 _init();
13
14 #
15 # To dump the Javascript version of the fieldmapper struct use the command:
16 #
17 #       PERL5LIB=~/cvs/ILS/OpenSRF/src/perlmods/:~/cvs/ILS/Open-ILS/src/perlmods/ GEN_JS=1 perl -MOpenILS::Utils::Fieldmapper -e 'print "\n";'
18 #
19 # ... adjusted for your CVS sandbox, of course.
20 #
21
22 sub classes {
23         return () unless (defined $fieldmap);
24         return keys %$fieldmap;
25 }
26
27 sub _init {
28         return if (defined $fieldmap);
29
30         $fieldmap = 
31         {
32                 'Fieldmapper::actor::user'                      => { hint => 'au'   },
33                 'Fieldmapper::actor::org_unit'                  => { hint => 'aou'  },
34                 'Fieldmapper::actor::org_unit_type'             => { hint => 'aout' },
35                 'Fieldmapper::biblio::record_node'              => { hint               => 'brn',
36                                                                      proto_fields       => { children => 1 } },
37                 'Fieldmapper::biblio::record_entry'             => { hint => 'bre'  },
38                 'Fieldmapper::config::bib_source'               => { hint => 'cbs'  },
39                 'Fieldmapper::config::metabib_field'            => { hint => 'cmf'  },
40                 'Fieldmapper::metabib::metarecord'              => { hint => 'mmr'  },
41                 'Fieldmapper::metabib::title_field_entry'       => { hint => 'mmr'  },
42                 'Fieldmapper::metabib::author_field_entry'      => { hint => 'mmr'  },
43                 'Fieldmapper::metabib::subject_field_entry'     => { hint => 'mmr'  },
44                 'Fieldmapper::metabib::keyword_field_entry'     => { hint => 'mmr'  },
45                 'Fieldmapper::metabib::full_rec'                => { hint => 'mmr'  },
46         };
47
48         #-------------------------------------------------------------------------------
49         # Now comes the evil!  Generate classes
50
51         for my $pkg ( keys %$fieldmap ) {
52                 (my $cdbi = $pkg) =~ s/^Fieldmapper:://o;
53
54                 eval <<"                PERL";
55                         package $pkg;
56                         use base 'Fieldmapper';
57                 PERL
58
59                 $$fieldmapp{$pkg}{cdbi} = $cdbi;
60
61                 my $pos = 0;
62                 for my $vfield ( qw/isnew ischanged isdeleted/ ) {
63                         $$fieldmap{$pkg}{fields}{$vfield} = { position => $pos, virtual => 1 };
64                         $pos++;
65                 }
66
67                 if (exists $$fieldmap{$pkg}{proto_fields}) {
68                         for my $pfield ( keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
69                                 $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
70                                 $pos++;
71                         }
72                 }
73
74                 for my $col ( $cdbi->columns('All') ) {
75                         $$fieldmap{$pkg}{fields}{$col} = { position => $pos, virtual => 0 };
76                         $pos++;
77                 }
78
79                 JSON->register_class_hint(
80                         hint => $pkg->json_hint,
81                         name => $pkg,
82                         type => 'array',
83                 );
84
85         }
86
87         print Fieldmapper->javascript() if ($ENV{GEN_JS});
88 }
89
90 sub new {
91         my $self = shift;
92         my $value = shift;
93         $value = [] unless (defined $value);
94         return bless $value => $self->class_name;
95 }
96
97 sub javascript {
98         my $class_name = shift;
99         return 'var fieldmap = ' . JSON->perl2JSON($fieldmap) . ';'
100 }
101
102 sub DESTROY {}
103
104 sub AUTOLOAD {
105         my $obj = shift;
106         my $value = shift;
107         (my $field = $AUTOLOAD) =~ s/^.*://o;
108         my $class_name = $obj->class_name;
109
110         die "No field by the name $field in $class_name!"
111                 unless (exists $$fieldmap{$class_name}{fields}{$field});
112
113         my $pos = $$fieldmap{$class_name}{fields}{$field}{position};
114
115         {       no strict 'subs';
116                 *{$obj->class_name."::$field"} = sub {
117                         my $self = shift;
118                         my $new_val = shift;
119                         $self->[$pos] = $new_val if (defined $new_val);
120                         return $self->[$pos];
121                 };
122         }
123
124         return $obj->$field($value);
125 }
126
127 sub class_name {
128         my $class_name = shift;
129         return ref($class_name) || $class_name;
130 }
131
132 sub real_fields {
133         my $self = shift;
134         my $class_name = $self->class_name;
135         my $fields = $$fieldmap{$class_name}{fields};
136
137         my @f = grep {
138                         !$$fields{$_}{virtual}
139                 } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
140
141         return @f;
142 }
143
144 sub api_level {
145         my $self = shift;
146         return $fieldmap->{$self->class_name}->{api_level};
147 }
148
149 sub api_level {
150         my $self = shift;
151         return $fieldmap->{$self->class_name}->{api_level};
152 }
153
154 sub json_hint {
155         my $self = shift;
156         return $fieldmap->{$self->class_name}->{hint};
157 }
158
159
160 1;