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

   1 package Fieldmapper;
   2 use JSON;
   3 use vars qw/$fieldmap @class_name_list/;
   4
   5 $fieldmap =
   6 {
   7         'Fieldmapper::biblio::record_node' =>
   8         {
   9                 hint            => 'brn1',
  10                 api_level       => 1,
  11                 fields          =>
  12                 {
  13                         id              => { position =>  0, virtual => 0 },
  14                         owner_doc       => { position =>  1, virtual => 0 },
  15                         intra_doc_id    => { position =>  2, virtual => 0 },
  16                         parent_node     => { position =>  3, virtual => 0 },
  17                         node_type       => { position =>  4, virtual => 0 },
  18                         namespace_uri   => { position =>  5, virtual => 0 },
  19                         name            => { position =>  6, virtual => 0 },
  20                         value           => { position =>  7, virtual => 0 },
  21
  22                         isnew           => { position =>  8, virtual => 1 },
  23                         ischanged       => { position =>  9, virtual => 1 },
  24                         isdeleted       => { position => 10, virtual => 1 },
  25                         children        => { position => 11, virtual => 1 },
  26                 },
  27         },
  28
  29         'Fieldmapper::biblio::record_entry' =>
  30         {
  31                 hint            => 'bre1',
  32                 api_level       => 1,
  33                 fields          =>
  34                 {
  35                         id              => { position =>  0, virtual => 0 },
  36                         tcn_source      => { position =>  1, virtual => 0 },
  37                         tcn_value       => { position =>  2, virtual => 0 },
  38                         metarecord      => { position =>  3, virtual => 0 },
  39                         creator         => { position =>  4, virtual => 0 },
  40                         editor          => { position =>  5, virtual => 0 },
  41                         create_date     => { position =>  6, virtual => 0 },
  42                         edit_date       => { position =>  7, virtual => 0 },
  43                         source          => { position =>  8, virtual => 0 },
  44                         active          => { position =>  9, virtual => 0 },
  45                         deleted         => { position => 10, virtual => 0 },
  46
  47                         isnew           => { position => 11, virtual => 1 },
  48                         ischanged       => { position => 12, virtual => 1 },
  49                         isdeleted       => { position => 13, virtual => 1 },
  50                 },
  51         },
  52
  53         'Fieldmapper::actor::user' =>
  54         {
  55                 hint            => 'au1',
  56                 api_level       => 1,
  57                 fields          =>
  58                 {
  59                         id                      => { position =>  0, virtual => 0 },
  60                         usrid                   => { position =>  1, virtual => 0 },
  61                         usrname                 => { position =>  2, virtual => 0 },
  62                         email                   => { position =>  3, virtual => 0 },
  63                         prefix                  => { position =>  4, virtual => 0 },
  64                         first_given_name        => { position =>  5, virtual => 0 },
  65                         second_given_name       => { position =>  6, virtual => 0 },
  66                         family_name             => { position =>  7, virtual => 0 },
  67                         suffix                  => { position =>  8, virtual => 0 },
  68                         address                 => { position =>  9, virtual => 0 },
  69                         home_ou                 => { position => 10, virtual => 0 },
  70                         gender                  => { position => 11, virtual => 0 },
  71                         dob                     => { position => 12, virtual => 0 },
  72                         active                  => { position => 13, virtual => 0 },
  73                         master_acount           => { position => 14, virtual => 0 },
  74                         super_user              => { position => 15, virtual => 0 },
  75                         usrgroup                => { position => 16, virtual => 0 },
  76                         passwd                  => { position => 17, virtual => 0 },
  77
  78                         isnew                   => { position => 18, virtual => 1 },
  79                         ischanged               => { position => 19, virtual => 1 },
  80                         isdeleted               => { position => 20, virtual => 1 },
  81                 },
  82         },
  83 };
  84
  85 sub new {
  86         my $self = shift;
  87         my $value = shift;
  88         $value = [] unless (defined $value);
  89         return bless $value => $self->class_name;
  90 }
  91
  92 sub javascript {
  93         my $class_name = shift;
  94         return 'var fieldmap = ' . JSON->perl2JSON($fieldmap) . ';'
  95 }
  96
  97 sub DESTROY {}
  98
  99 sub AUTOLOAD {
 100         my $obj = shift;
 101         my $value = shift;
 102         (my $field = $AUTOLOAD) =~ s/^.*://o;
 103         my $class_name = $obj->class_name;
 104
 105         die "No field by the name $field in $class_name!"
 106                 unless (exists $$fieldmap{$class_name}{fields}{$field});
 107
 108         my $pos = $$fieldmap{$class_name}{fields}{$field}{position};
 109
 110         {       no strict 'subs';
 111                 *{$obj->class_name."::$field"} = sub {
 112                         my $self = shift;
 113                         my $new_val = shift;
 114                         $self->[$pos] = $new_val if (defined $new_val);
 115                         return $self->[$pos];
 116                 };
 117         }
 118
 119         return $obj->$field($value);
 120 }
 121
 122 sub class_name {
 123         my $class_name = shift;
 124         return ref($class_name) || $class_name;
 125 }
 126
 127 sub real_fields {
 128         my $self = shift;
 129         my $class_name = $self->class_name;
 130         my $fields = $$fieldmap{$class_name}{fields};
 131
 132         my @f = grep {
 133                         !$$fields{$_}{virtual}
 134                 } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
 135
 136         return @f;
 137 }
 138
 139 sub api_level {
 140         my $self = shift;
 141         return $fieldmap->{$self->class_name}->{api_level};
 142 }
 143
 144 sub json_hint {
 145         my $self = shift;
 146         return $fieldmap->{$self->class_name}->{hint};
 147 }
 148
 149
 150 #-------------------------------------------------------------------------------
 151 # Now comes the evil!  Generate classes
 152
 153 for my $pkg ( keys %$fieldmap ) {
 154         eval <<"        PERL";
 155                 package $pkg;
 156                 use base 'Fieldmapper';
 157         PERL
 158
 159         push @class_name_list, $pkg;
 160
 161         JSON->register_class_hint(
 162                 hint => $pkg->json_hint,
 163                 name => $pkg,
 164                 type => 'array',
 165         );
 166
 167 }
 168 print Fieldmapper->javascript() if ($ENV{GEN_JS});
 169
 170 1;