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, $file ) = @_;
  10         $class = ref($class) || $class;
  11         my $self = { file => $file };
  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         $self->context($js);
  32         return $self;
  33 }
  34
  35
  36 sub load {
  37         my( $self, $filename ) = @_;
  38         $self->{file} = $filename;
  39 }
  40
  41 sub run {
  42         my $self = shift;
  43         my $file = shift() || $self->{file};
  44
  45         if( ! open(F, $file) ) {
  46                 $logger->error("Error opening script file: $file");
  47                 return 0;
  48         }
  49
  50         my $js = $self->context;
  51         $js->property_by_path("js.file", join( "\n", <F> ));
  52
  53         if( ! $js->eval("eval( js.file );") ) {
  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_fm {
  74
  75         my( $self, $key, $fm ) = @_;
  76         my $ctx = $self->context;
  77         return undef unless ($ctx and $key and $fm);
  78         my $o = $ctx->object_by_path($key);
  79
  80         for my $f ( $fm->properties ) {
  81                 $ctx->property_by_path("$key.$f", $fm->$f(),
  82
  83                         sub {
  84                                 my $k = _js_prop_name(shift());
  85                                 $fm->$k();
  86                         },
  87
  88                         sub {
  89                                 my $k = _js_prop_name(shift());
  90                                 $fm->ischanged(1);
  91                                 $fm->$k(@_);
  92                         }
  93                 );
  94         }
  95 }
  96
  97 sub insert_hash {
  98
  99         my( $self, $key, $hash ) = @_;
 100         my $ctx = $self->context;
 101         return undef unless ($ctx and $key and $hash);
 102         $ctx->object_by_path($key);
 103
 104         for my $k ( keys %$hash ) {
 105                 $ctx->property_by_path(
 106                         "$key.$k", $hash->{$k},
 107                         sub { $hash->{_js_prop_name(shift())} },
 108                         sub {
 109                                 my( $key, $val ) = @_;
 110                                 $hash->{_js_prop_name($key)} = $val; }
 111                 );
 112         }
 113 }
 114
 115 1;