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

   1 package Fieldmapper;
   2 use JSON;
   3 use vars qw/$fieldmap @class_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;
  90 }
  91
  92 sub javascript {
  93         my $class = shift;
  94         $class = $class->class;
  95         my $js_class = $class->json_hint;
  96
  97         my $output = <<"        JS";
  98
  99 function $js_class (thing) { var new = thing; if (!new) { new = []; } return new; }
 100   $js_class.prototype.class_name = function () { return "$js_class"; }
 101         JS
 102
 103         for my $field ( sort keys %{$$fieldmap{$class}{fields}} ) {
 104                 my $pos = $$fieldmap{$class}{fields}{$field}{position};
 105                 $output .= <<"          JS";
 106   $js_class.prototype.$field = function (arg) { if (arg) { this[$pos] = arg; } return this[$pos]; }
 107                 JS
 108         }
 109         return $output;
 110 }
 111
 112 sub AUTOLOAD {
 113         my $obj = shift;
 114         my $value = shift;
 115         (my $field = $AUTOLOAD) =~ s/^.*://o;
 116         my $class = $obj->class;
 117
 118         die "No field by the name $field in $class!"
 119                 unless (exists $$fieldmap{$class}{fields}{$field});
 120
 121         my $pos = $$fieldmap{$class}{fields}{$field}{position};
 122
 123         {       no strict 'subs';
 124                 *{$obj->class."::$field"} = sub {
 125                         my $self = shift;
 126                         my $new_val = shift;
 127                         $self->[$pos] = $new_val if (defined $new_val);
 128                         return $self->[$pos];
 129                 };
 130         }
 131
 132         return $obj->$field($value);
 133 }
 134
 135 sub class {
 136         my $class = shift;
 137         return ref($class) || $class;
 138 }
 139
 140 sub real_fields {
 141         my $class = shift;
 142         my @f = grep {
 143                         !$$fieldmap{$self->class}{fields}{$_}{virtual}
 144                 } keys %{$$fieldmap{$self->class}{fields}};
 145
 146         return @f;
 147 }
 148
 149 sub api_level {
 150         my $self = shift;
 151         return $fieldmap->{$self->class}->{api_level};
 152 }
 153
 154 sub json_hint {
 155         my $self = shift;
 156         return $fieldmap->{$self->class}->{hint};
 157 }
 158
 159
 160 #-------------------------------------------------------------------------------
 161 # Now comes the evil!  Generate classes
 162
 163 for my $pkg ( keys %$fieldmap ) {
 164         eval <<"        PERL";
 165                 package $pkg;
 166                 use base 'Fieldmapper';
 167         PERL
 168
 169         push @class_list, $pkg;
 170
 171         JSON->register_class_hint(
 172                 hint => $pkg->json_hint,
 173                 name => $pkg,
 174                 type => 'array',
 175         );
 176
 177         print $pkg->javascript if ($ENV{GEN_JS});
 178 }
 179
 180 1;