a1da49ea88f2142030cd8e81377900dc187a00d3
[Evergreen.git] / 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;