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

   1 package OpenILS::Utils::SpiderMonkey;
   2 use strict; use warnings;
   3 use OpenSRF::Utils::Logger qw(:logger);
   4 use OpenILS::Utils::ScriptRunner;
   5 use base 'OpenILS::Utils::ScriptRunner';
   6 use JavaScript::SpiderMonkey;
   7
   8 sub new {
   9         my ( $class, %params ) = @_;
  10         $class = ref($class) || $class;
  11         my $self = { file => $params{file}, libs => $params{libs} };
  12         return bless( $self, $class );
  13 }
  14
  15 sub context {
  16         my( $self, $context ) = @_;
  17         $self->{ctx} = $context if $context;
  18         return $self->{ctx};
  19 }
  20
  21 sub init {
  22         my $self = shift;
  23         my $js = JavaScript::SpiderMonkey->new();
  24         $js->init();
  25         $js->function_set("perl_print",         sub { print "@_\n"; } );
  26         $js->function_set("log_activity",       sub { $logger->activity(@_); return 1;} );
  27         $js->function_set("log_error",          sub { $logger->error(@_); return 1;} );
  28         $js->function_set("log_warn",                   sub { $logger->warn(@_); return 1;} );
  29         $js->function_set("log_info",                   sub { $logger->info(@_); return 1;} );
  30         $js->function_set("log_debug",          sub { $logger->debug(@_); return 1;} );
  31         $js->function_set("log_internal",       sub { $logger->internal(@_); return 1;} );
  32         $js->function_set("debug",                              sub { $logger->debug(@_); return 1;} );
  33         $js->function_set("alert",                              sub { $logger->warn(@_); return 1;} );
  34         $self->context($js);
  35         $self->load_lib($_) for @{$self->{libs}};
  36 }
  37
  38
  39 sub load {
  40         my( $self, $filename ) = @_;
  41         $self->{file} = $filename;
  42 }
  43
  44 sub run {
  45         my $self = shift;
  46         my $file = shift() || $self->{file};
  47         my $js = $self->context;
  48
  49         if( ! open(F, $file) ) {
  50                 $logger->error("Error opening script file: $file");
  51                 return 0;
  52         }
  53
  54         if( ! $js->eval(join("\n", <F>)) ) {
  55                 $logger->error("Script ($file) eval failed in SpiderMonkey run: $@");
  56                 return 0;
  57         }
  58
  59         close(F);
  60         return 1;
  61 }
  62
  63 sub load_lib {
  64         my( $self, $file ) = @_;
  65         $self->run( $file );
  66 }
  67
  68 sub _js_prop_name {
  69         my $name = shift;
  70         $name =~ s/^.*\.//o;
  71         return $name;
  72 }
  73
  74 sub retrieve {
  75         my( $self, $key ) = @_;
  76         return $self->context->property_get($key);
  77 }
  78
  79 sub insert_method {
  80         my( $self, $obj_key, $meth_name, $sub ) = @_;
  81         my $obj = $self->context->object_by_path( $obj_key );
  82         $self->context->function_set( $meth_name, $sub, $obj ) if $obj;
  83 }
  84
  85
  86 sub insert {
  87         my( $self, $key, $val ) = @_;
  88         return unless defined($key);
  89
  90         if (ref($val) =~ /^Fieldmapper/o) {
  91                 $self->insert_fm($key, $val);
  92         } elsif (ref($val) and $val =~ /ARRAY/o) {
  93                 $self->insert_array($key, $val);
  94         } elsif (ref($val) and $val =~ /HASH/o) {
  95                 $self->insert_hash($key, $val);
  96         } elsif (ref($val) and $val =~ /CODE/o) {
  97                 $self->context->function_set( $key, $val );
  98         } elsif (!ref($val)) {
  99                 if( defined($val) ) {
 100                         $self->context->property_by_path(
 101                                 $key, $val,
 102                                 sub { $val },
 103                                 sub { my( $k, $v ) = @_; $val = $v; }
 104                         );
 105                 } else {
 106                         $self->context->property_by_path($key);
 107                 }
 108
 109         } else {
 110                 return 0;
 111         }
 112
 113         return 1;
 114 }
 115
 116 sub insert_fm {
 117
 118         my( $self, $key, $fm ) = @_;
 119         my $ctx = $self->context;
 120         return undef unless ($ctx and $key and $fm);
 121         my $o = $ctx->object_by_path($key);
 122
 123         for my $f ( $fm->properties ) {
 124                 my $val = $fm->$f();
 125                 if (ref $val) {
 126                         $self->insert("$key.$f", $val);
 127                 } else {
 128                         $ctx->property_by_path(
 129                                 "$key.$f",
 130                                 $val,
 131                                 sub {
 132                                         my $k = _js_prop_name(shift());
 133                                         $fm->$k();
 134                                 },
 135
 136                                 sub {
 137                                         my $k = _js_prop_name(shift());
 138                                         $fm->ischanged(1);
 139                                         $fm->$k(@_);
 140                                 }
 141                         );
 142                 }
 143         }
 144 }
 145
 146 sub insert_hash {
 147
 148         my( $self, $key, $hash ) = @_;
 149         my $ctx = $self->context;
 150         return undef unless ($ctx and $key and $hash);
 151         $ctx->object_by_path($key);
 152
 153         for my $k ( keys %$hash ) {
 154                 my $v = $hash->{$k};
 155                 if (ref $v) {
 156                         $self->insert("$key.$k", $v);
 157                 } else {
 158                         $ctx->property_by_path(
 159                                 "$key.$k", $v,
 160                                 sub { $hash->{_js_prop_name(shift())} },
 161                                 sub {
 162                                         my( $key, $val ) = @_;
 163                                         $hash->{_js_prop_name($key)} = $val; }
 164                         );
 165                 }
 166         }
 167 }
 168
 169 my $__array_id = 0;
 170 sub insert_array {
 171
 172         my( $self, $key, $array ) = @_;
 173         my $ctx = $self->context;
 174         return undef unless ($ctx and $key and $array);
 175
 176         my $a = $ctx->array_by_path($key);
 177
 178         my $ind = 0;
 179         for my $v ( @$array ) {
 180                 if (ref $v) {
 181                         my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id);
 182                         $self->insert('__tmp_arr_el'.$__array_id, $v);
 183                         $ctx->array_set_element_as_object( $a, $ind, $elobj );
 184                         $__array_id++;
 185                 } else {
 186                         $ctx->array_set_element( $a, $ind, $v ) if defined($v);
 187                 }
 188                 $ind++;
 189         }
 190 }
 191
 192 1;