eb7b2ecea383327813cac164cd543d4ab62f6727
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Utils / ScriptRunner.pm
1 package OpenILS::Utils::ScriptRunner;
2 use strict; use warnings;
3 use OpenSRF::Utils::Logger qw(:logger);
4 use OpenSRF::EX qw(:try);
5 use JavaScript::SpiderMonkey;
6 use LWP::UserAgent;
7 use XML::LibXML;
8 use Time::HiRes qw/time/;
9 use vars qw/%_paths/;
10
11
12 sub new {
13         my $class = shift;
14         my %params = @_;
15         $class = ref($class) || $class;
16         $params{paths} ||= [];
17
18         my $self = bless {      file => $params{file},
19                                 libs => $params{libs},
20                                 _path => {%_paths} } => $class;
21
22         $self->add_path($_) for @{$params{paths}};
23         return $self->init; 
24 }
25
26 sub context {
27         my( $self, $context ) = @_;
28         $self->{ctx} = $context if $context;
29         return $self->{ctx};
30 }
31
32 sub init {
33         my $self = shift;
34         $self->context( new JavaScript::SpiderMonkey );
35         $self->context->init();
36
37
38         # eating our own dog food with insert
39         $self->insert(perl_print        => sub { print "@_\n"; } );
40         $self->insert(perl_warn         => sub { warn @_; } );
41         $self->insert(log_activity      => sub { $logger->activity(@_); return 1;} );
42         $self->insert(log_error         => sub { $logger->error(@_); return 1;} );
43         $self->insert(log_warn          => sub { $logger->warn(@_); return 1;} );
44         $self->insert(log_info          => sub { $logger->info(@_); return 1;} );
45         $self->insert(log_debug         => sub { $logger->debug(@_); return 1;} );
46         $self->insert(log_internal      => sub { $logger->internal(@_); return 1;} );
47         $self->insert(debug             => sub { $logger->debug(@_); return 1;} );
48         $self->insert(alert             => sub { $logger->warn(@_); return 1;} );
49         $self->insert(load_lib          => sub { $self->load_lib(@_); });
50
51         # XML support functions
52         $self->insert(
53                 _OILS_FUNC_xmlhttprequest_send  => sub { $self->_xmlhttprequest_send(@_); });
54         $self->insert(
55                 _OILS_FUNC_xml_parse_string     => sub { $self->_parse_xml_string(@_); });
56         
57         $self->load_lib($_) for @{$self->{libs}};
58
59         return $self;
60 }
61
62 sub refresh_context {
63         my $self = shift;
64         $self->context->destroy;
65         $self->init;
66 }
67
68 sub load {
69         my( $self, $filename ) = @_;
70         $self->{file} = $filename;
71 }
72
73 sub run {
74         my $self = shift;
75         my $file = shift() || $self->{file};
76         my $js = $self->context;
77
78         $file = $self->_find_file($file);
79
80         if( ! open(F, $file) ) {
81                 $logger->error("Error opening script file: $file");
82                 return 0;
83         }
84
85         {       local $/ = undef;
86                 my $content = <F>;
87                 my $s = time();
88                 if( !$js || !$content || !$js->eval($content) ) {
89                         $logger->error("$file Eval failed: $@");  
90                         return 0;
91                 }
92                 $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
93         }
94
95         close(F);
96         return 1;
97 }
98
99 sub remove_path { 
100         my( $self, $path ) = @_;
101         if (ref($self)) {
102                 if ($self->{_path}{$path}) {
103                         $self->{_path}{$path} = 0;
104                 }
105                 return $self->{_path}{$path};
106         } else {
107                 if ($_paths{$path}) {
108                         $_paths{$path} = 0;
109                 }
110                 return $_paths{$path};
111         }
112 }
113
114 sub add_path { 
115         my( $self, $path ) = @_;
116         if (ref($self)) {
117                 if (!$self->{_path}{$path}) {
118                         $self->{_path}{$path} = 1;
119                 }
120         } else {
121                 if (!$_paths{$path}) {
122                         $_paths{$path} = 1;
123                 }
124         }
125         return $self;
126 }
127
128 sub _find_file {
129         my $self = shift;
130         my $file = shift;
131         for my $p ( keys %{ $self->{_path} } ) {
132                 next unless ($self->{_path}{$p});
133                 my $full = join('/',$p,$file);
134                 return $full if (-e $full);
135         }
136 }
137
138 sub load_lib { 
139         my( $self, $file ) = @_;
140         if (!$self->{_loaded}{$file} && $self->run( $file )) {
141                 $self->{_loaded}{$file} = 1;
142         }
143         return $self->{_loaded}{$file};
144 }
145
146 sub _js_prop_name {
147         my $name = shift;
148         $name =~ s/^.*\.//o;
149         return $name;
150 }
151
152 sub retrieve {
153         my( $self, $key ) = @_;
154         return $self->context->property_get($key);
155 }
156
157 sub insert_method {
158         my( $self, $obj_key, $meth_name, $sub ) = @_;
159         my $obj = $self->context->object_by_path( $obj_key );
160         $self->context->function_set( $meth_name, $sub, $obj ) if $obj;
161 }
162
163
164 sub insert {
165         my( $self, $key, $val, $RO ) = @_;
166         return unless defined($key);
167
168         if (ref($val) =~ /^Fieldmapper/o) {
169                 $self->insert_fm($key, $val, $RO);
170         } elsif (ref($val) and $val =~ /ARRAY/o) {
171                 $self->insert_array($key, $val, $RO);
172         } elsif (ref($val) and $val =~ /HASH/o) {
173                 $self->insert_hash($key, $val, $RO);
174         } elsif (ref($val) and $val =~ /CODE/o) {
175                 $self->context->function_set( $key, $val );
176         } elsif (!ref($val)) {
177                 if( defined($val) ) {
178                         $self->context->property_by_path(
179                                 $key, $val,
180                                 sub { $val },
181                                 ( !$RO ?
182                                         sub { my( $k, $v ) = @_; $val = $v; } :
183                                         sub{}
184                                 )
185                         );
186                 } else {
187                         $self->context->property_by_path($key);
188                 }
189
190         } else {
191                 return 0;
192         }
193
194         return 1;
195 }
196
197 sub insert_fm {
198
199         my( $self, $key, $fm, $RO ) = @_;
200         my $ctx = $self->context;
201         return undef unless ($ctx and $key and $fm);
202         my $o = $ctx->object_by_path($key);
203         
204         for my $f ( $fm->properties ) {
205                 my $val = $fm->$f();
206                 if (ref $val) {
207                         $self->insert("$key.$f", $val);
208                 } else {
209                         $ctx->property_by_path(
210                                 "$key.$f",
211                                 $val,
212                                 sub {
213                                         my $k = _js_prop_name(shift());
214                                         $fm->$k();
215                                 }, 
216
217                                 ( !$RO ? 
218                                         sub {
219                                                 my $k = _js_prop_name(shift());
220                                                 $fm->ischanged(1);
221                                                 $fm->$k(@_);
222                                         } :
223                                         sub {}
224                                 )
225                         );
226                 }
227         }
228 }
229
230 sub insert_hash {
231
232         my( $self, $key, $hash, $RO ) = @_;
233         my $ctx = $self->context;
234         return undef unless ($ctx and $key and $hash);
235         $ctx->object_by_path($key);
236         
237         for my $k ( keys %$hash ) {
238                 my $v = $hash->{$k};
239                 if (ref $v) {
240                         $self->insert("$key.$k", $v);
241                 } else {
242                         $ctx->property_by_path(
243                                 "$key.$k", $v,
244                                 sub { $hash->{_js_prop_name(shift())} },
245                                 ( !$RO ? 
246                                         sub {
247                                                 my( $hashkey, $val ) = @_;
248                                                 $hash->{_js_prop_name($hashkey)} = $val; }
249                                         } :
250                                         sub {}
251                                 )
252                         );
253                 }
254         }
255 }
256
257 my $__array_id = 0;
258 sub insert_array {
259
260         my( $self, $key, $array ) = @_;
261         my $ctx = $self->context;
262         return undef unless ($ctx and $key and $array);
263
264         my $a = $ctx->array_by_path($key);
265         
266         my $ind = 0;
267         for my $v ( @$array ) {
268                 if (ref $v) {
269                         my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id);
270                         $self->insert('__tmp_arr_el'.$__array_id, $v);
271                         $ctx->array_set_element_as_object( $a, $ind, $elobj );
272                         $__array_id++;
273                 } else {
274                         $ctx->array_set_element( $a, $ind, $v ) if defined($v);
275                 }
276                 $ind++;
277         }
278 }
279
280 sub _xmlhttprequest_send {
281         my $self = shift;
282         my $id = shift;
283         my $method = shift;
284         my $url = shift;
285         my $blocking = shift;
286         my $headerlist = shift;
287         my $data = shift;
288
289         my $ctx = $self->context;
290
291         # just so perl has access to it...
292         $ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
293
294         my $headers = new HTTP::Headers;
295         my @lines = split(/\n/so, $headerlist);
296         for my $line (@lines) {
297                 if ($line =~ /^(.+?)|(.+)$/o) {
298                         $headers->header($1 => $2);
299                 }
300         }
301
302         my $ua = LWP::UserAgent->new;
303         $ua->agent("OpenILS/0.1");
304
305         my $req = HTTP::Request->new($method => $url => $headers => $data);
306         my $res = $ua->request($req);
307
308         if ($res->is_success) {
309                 
310                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
311                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
312                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
313                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
314
315         }
316                 
317 }
318
319 sub _parse_xml_string {
320         my $self = shift;
321         my $string = shift;
322         my $key = shift;
323
324
325         my $doc;
326         my $s = 0;
327         try {
328                 $doc = XML::LibXML->new->parse_string( $string );
329                 $s = 1;
330         } catch Error with {
331                 my $e = shift;
332                 warn "Could not parse document: $e\n";
333         };
334         return unless ($s);
335
336         _JS_DOM($self->context, $key, $doc);
337 }
338
339 sub _JS_DOM {
340         my $ctx = shift;
341         my $key = shift;
342         my $node = shift;
343
344         if ($node->nodeType == 9) {
345                 $node = $node->documentElement;
346
347                 my $n = $node->nodeName;
348                 my $ns = $node->namespaceURI;
349                 $ns =~ s/'/\'/gso if ($ns);
350                 $ns = "'$ns'" if ($ns);
351                 $ns = 'null' unless ($ns);
352                 $n =~ s/'/\'/gso;
353
354                 #warn("$key = DOMImplementation().createDocument($ns,'$n');");
355                 $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
356
357                 $key = $key.'.documentElement';
358         }
359
360         for my $a ($node->attributes) {
361                 my $n = $a->nodeName;
362                 my $v = $a->value;
363                 $n =~ s/'/\'/gso;
364                 $v =~ s/'/\'/gso;
365                 #warn("$key.setAttribute('$n','$v');");
366                 $ctx->eval("$key.setAttribute('$n','$v');");
367
368         }
369
370         my $k = 0;
371         for my $c ($node->childNodes) {
372                 if ($c->nodeType == 1) {
373                         my $n = $c->nodeName;
374                         my $ns = $node->namespaceURI;
375
376                         $n =~ s/'/\'/gso;
377                         $ns =~ s/'/\'/gso if ($ns);
378                         $ns = "'$ns'" if ($ns);
379                         $ns = 'null' unless ($ns);
380
381                         #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
382                         $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
383                         _JS_DOM($ctx, "$key.childNodes.item($k)",$c);
384
385                 } elsif ($c->nodeType == 3) {
386                         my $n = $c->data;
387                         $n =~ s/'/\'/gso;
388                         #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
389                         #warn("path is $key.item($k);");
390                         $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
391
392                 } elsif ($c->nodeType == 4) {
393                         my $n = $c->data;
394                         $n =~ s/'/\'/gso;
395                         #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
396                         $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
397
398                 } elsif ($c->nodeType == 8) {
399                         my $n = $c->data;
400                         $n =~ s/'/\'/gso;
401                         #warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
402                         $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
403
404                 } else {
405                         warn "ACK! I don't know how to handle node type ".$c->nodeType;
406                 }
407                 
408
409                 $k++;
410         }
411
412         return 1;
413 }
414
415
416
417 1;