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_error",          sub { $logger->error(@_); return 1;} );
  27         $js->function_set("log_warn",                   sub { $logger->warn(@_); return 1;} );
  28         $js->function_set("log_info",                   sub { $logger->info(@_); return 1;} );
  29         $js->function_set("log_debug",          sub { $logger->debug(@_); return 1;} );
  30         $js->function_set("log_internal",       sub { $logger->internal(@_); return 1;} );
  31         $js->function_set("debug",                              sub { $logger->debug(@_); return 1;} );
  32         $js->function_set("alert",                              sub { $logger->warn(@_); return 1;} );
  33         $self->context($js);
  34         $self->load_lib($_) for @{$self->{libs}};
  35 }
  36
  37
  38 sub load {
  39         my( $self, $filename ) = @_;
  40         $self->{file} = $filename;
  41 }
  42
  43 sub run {
  44         my $self = shift;
  45         my $file = shift() || $self->{file};
  46         my $js = $self->context;
  47
  48         if( ! open(F, $file) ) {
  49                 $logger->error("Error opening script file: $file");
  50                 return 0;
  51         }
  52
  53         if( ! $js->eval(join("\n", <F>)) ) {
  54                 $logger->error("$file Eval failed: $@");
  55                 return 0;
  56         }
  57
  58         close(F);
  59         return 1;
  60 }
  61
  62 sub load_lib {
  63         my( $self, $file ) = @_;
  64         $self->run( $file );
  65 }
  66
  67 sub _js_prop_name {
  68         my $name = shift;
  69         $name =~ s/^.*\.//o;
  70         return $name;
  71 }
  72
  73 sub insert {
  74         my( $self, $key, $val ) = @_;
  75
  76         if (ref($val) =~ /^Fieldmapper/o) {
  77                 $self->insert_fm($key, $val);
  78         } elsif (ref($val) and $val =~ /ARRAY/o) {
  79                 $self->insert_array($key, $val);
  80         } elsif (ref($val) and $val =~ /HASH/o) {
  81                 $self->insert_hash($key, $val);
  82         } elsif (!ref($val)) {
  83                 $self->context->property_by_path(
  84                         $key, $val,
  85                         sub { $val },
  86                         sub { my( $k, $v ) = @_; $val = $v; }
  87                 );
  88         } else {
  89                 return 0;
  90         }
  91
  92         return 1;
  93 }
  94
  95 sub insert_fm {
  96
  97         my( $self, $key, $fm ) = @_;
  98         my $ctx = $self->context;
  99         return undef unless ($ctx and $key and $fm);
 100         my $o = $ctx->object_by_path($key);
 101
 102         for my $f ( $fm->properties ) {
 103                 my $val = $fm->$f();
 104                 if (ref $val) {
 105                         $self->insert("$key.$f", $val);
 106                 } else {
 107                         $ctx->property_by_path(
 108                                 "$key.$f",
 109                                 $val,
 110                                 sub {
 111                                         my $k = _js_prop_name(shift());
 112                                         $fm->$k();
 113                                 },
 114
 115                                 sub {
 116                                         my $k = _js_prop_name(shift());
 117                                         $fm->ischanged(1);
 118                                         $fm->$k(@_);
 119                                 }
 120                         );
 121                 }
 122         }
 123 }
 124
 125 sub insert_hash {
 126
 127         my( $self, $key, $hash ) = @_;
 128         my $ctx = $self->context;
 129         return undef unless ($ctx and $key and $hash);
 130         $ctx->object_by_path($key);
 131
 132         for my $k ( keys %$hash ) {
 133                 my $v = $hash->{$k};
 134                 if (ref $v) {
 135                         $self->insert("$key.$k", $v);
 136                 } else {
 137                         $ctx->property_by_path(
 138                                 "$key.$k", $v,
 139                                 sub { $hash->{_js_prop_name(shift())} },
 140                                 sub {
 141                                         my( $key, $val ) = @_;
 142                                         $hash->{_js_prop_name($key)} = $val; }
 143                         );
 144                 }
 145         }
 146 }
 147
 148 sub insert_array {
 149
 150         my( $self, $key, $array ) = @_;
 151         my $ctx = $self->context;
 152         return undef unless ($ctx and $key and $array);
 153
 154         my $a = $ctx->array_by_path($key);
 155
 156         my $ind = 0;
 157         for my $v ( @$array ) {
 158                 if (ref $v) {
 159                         my $elobj = $ctx->object_by_path('__tmp_arr_el');
 160                         $self->insert('__tmp_arr_el', $v);
 161                         $ctx->array_set_element_as_object( $a, $ind, $elobj );
 162                 } else {
 163                         $ctx->array_set_element( $a, $ind, $v );
 164                 }
 165                 $ind++;
 166         }
 167 }
 168
 169 1;