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 use JSON;
   8
   9 sub new {
  10         my ( $class, %params ) = @_;
  11         $class = ref($class) || $class;
  12         my $self = { file => $params{file}, libs => $params{libs} };
  13         return bless( $self, $class );
  14 }
  15
  16 sub context {
  17         my( $self, $context ) = @_;
  18         $self->{ctx} = $context if $context;
  19         return $self->{ctx};
  20 }
  21
  22 sub init {
  23         my $self = shift;
  24         my $js = JavaScript::SpiderMonkey->new();
  25         $js->init();
  26         $js->function_set("perl_print",         sub { print "@_\n"; } );
  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("$file Eval failed: $@");
  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 insert {
  75         my( $self, $key, $val ) = @_;
  76         my $str = JSON->perl2JSON($val);
  77         warn "Inserting string: $str\n";
  78         my $js = $self->context;
  79         $js->object_by_path($key);
  80         if( ! $js->eval("$key = JSON2js('$str')")) {
  81                 $logger->error("Error inserting value with key $key: $@");
  82                 return 0;
  83         }
  84         return 1;
  85 }
  86
  87 sub retrieve {
  88         my( $self, $key ) = @_;
  89         my $val;
  90         my $js = $self->context;
  91
  92         $js->object_by_path("obj");
  93         $js->property_by_path("obj.out");
  94
  95         if( ! $js->eval("obj.out = js2JSON($key);")) {
  96                 $logger->error("Error retrieving value with $key: $@");
  97                 return undef;
  98         }
  99         my $str = $js->property_get("obj.out");
 100         warn "Retrieving [$key] string: $str\n";
 101         return JSON->JSON2perl($str);
 102 }
 103
 104
 105 sub insert_fm {
 106
 107         my( $self, $key, $fm ) = @_;
 108         my $ctx = $self->context;
 109         return undef unless ($ctx and $key and $fm);
 110         my $o = $ctx->object_by_path($key);
 111
 112         for my $f ( $fm->properties ) {
 113                 $ctx->property_by_path("$key.$f", $fm->$f(),
 114
 115                         sub {
 116                                 my $k = _js_prop_name(shift());
 117                                 $fm->$k();
 118                         },
 119
 120                         sub {
 121                                 my $k = _js_prop_name(shift());
 122                                 $fm->ischanged(1);
 123                                 $fm->$k(@_);
 124                         }
 125                 );
 126         }
 127 }
 128
 129 sub insert_hash {
 130
 131         my( $self, $key, $hash ) = @_;
 132         my $ctx = $self->context;
 133         return undef unless ($ctx and $key and $hash);
 134         $ctx->object_by_path($key);
 135
 136         for my $k ( keys %$hash ) {
 137                 $ctx->property_by_path(
 138                         "$key.$k", $hash->{$k},
 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 1;