]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm
plugging memory leak in SR
[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 JSON;
6 use JavaScript::SpiderMonkey;
7 use LWP::UserAgent;
8 use XML::LibXML;
9 use Time::HiRes qw/time/;
10 use vars qw/%_paths $__json_js/;
11
12 { local $/ = undef; $__json_js = <DATA>; }
13
14 sub new {
15         my $class = shift;
16         my %params = @_;
17         $class = ref($class) || $class;
18         $params{paths} ||= [];
19         $params{reset_count} ||= 0;
20
21         my $self = bless {      file => $params{file},
22                                 libs => $params{libs},
23                                 reset_count => $params{reset_count},
24                                 _runs => 0,
25                                 _path => {%_paths} } => $class;
26
27         $self->add_path($_) for @{$params{paths}};
28         return $self->init; 
29 }
30
31 sub context {
32         my( $self, $context ) = @_;
33         $self->{ctx} = $context if $context;
34         return $self->{ctx};
35 }
36
37 sub init {
38         my $self = shift;
39         $self->context( new JavaScript::SpiderMonkey );
40         $self->context->init();
41
42         $self->{_runs} = 0;
43
44         # eating our own dog food with insert
45         $self->insert(log_stdout        => sub { print "@_\n"; } );
46         $self->insert(log_stderr        => sub { warn "@_\n"; } );
47         $self->insert(log_activity      => sub { $logger->activity("script_runner: @_"); return 1;} );
48         $self->insert(log_error         => sub { $logger->error("script_runner: @_"); return 1;} );
49         $self->insert(log_warn          => sub { $logger->warn("script_runner: @_"); return 1;} );
50         $self->insert(log_info          => sub { $logger->info("script_runner: @_"); return 1;} );
51         $self->insert(log_debug         => sub { $logger->debug("script_runner: @_"); return 1;} );
52         $self->insert(log_internal      => sub { $logger->internal("script_runner: @_"); return 1;} );
53         $self->insert(debug             => sub { $logger->debug("script_runner: @_"); return 1;} );
54         $self->insert(alert             => sub { $logger->warn("script_runner: @_"); return 1;} );
55         $self->insert(load_lib          => sub { $self->load_lib(@_); return 1;});
56
57         # OpenSRF support functions
58         $self->insert(
59                 _OILS_FUNC_jsonopensrfrequest_send =>
60                         sub { $self->_jsonopensrfrequest_send(@_); }
61         );
62         $self->insert(
63                 _OILS_FUNC_jsonopensrfrequest_connect =>
64                         sub { $self->_jsonopensrfrequest_connect(@_); }
65         );
66         $self->insert(
67                 _OILS_FUNC_jsonopensrfrequest_disconnect =>
68                         sub { $self->_jsonopensrfrequest_disconnect(@_); }
69         );
70         $self->insert(
71                 _OILS_FUNC_jsonopensrfrequest_finish =>
72                         sub { $self->_jsonopensrfrequest_finish(@_); }
73         );
74
75         # XML support functions
76         $self->insert(
77                 _OILS_FUNC_xmlhttprequest_send  =>
78                         sub { $self->_xmlhttprequest_send(@_); }
79         );
80         $self->insert(
81                 _OILS_FUNC_xml_parse_string     =>
82                         sub { $self->_parse_xml_string(@_); }
83         );
84         
85         while ( my $e = shift @{$self->{_env}} ) {
86                 $self->insert( @$e{ qw/key value readonly/ } => 1 );
87         }
88
89         while ( my $e = shift @{$self->{_methods}} ) {
90                 $self->insert_method( @$e{ qw/key name meth/ } => 1 );
91         }
92
93         $self->load_lib($_) for @{$self->{libs}};
94
95         return $self;
96 }
97
98 sub refresh_context {
99         my $self = shift;
100         $logger->debug("Refreshing JavaScript Context...");
101         $self->context->destroy;
102         $logger->debug("Context destroyed");
103         $self->{_loaded} = {};
104         $logger->debug("Loaded scripts removed");
105         $self->init;
106         $logger->debug("New Context initialized");
107         return $self;
108 }
109
110 sub load {
111         my( $self, $filename ) = @_;
112         $self->{file} = $filename;
113 }
114
115 sub runs { shift()->{_runs} }
116
117 sub reset_count {
118         my $self = shift;
119         my $count = shift;
120
121         $self->{reset_count} = $count if ($count);
122         return $self->{reset_count};
123 }
124
125 sub run {
126         my $self = shift;
127         my $file = shift();
128
129         my $_real = 0;
130         if(!$file) {
131                 $_real = 1;
132                 $file = $self->{file};
133         }
134
135         $self->refresh_context
136                 if ($self->reset_count && $self->runs > $self->reset_count);
137
138         $self->{_runs}++ if ($_real);
139
140         $file = $self->_find_file($file);
141         $logger->debug("full script file path: $file");
142
143         if( ! open(F, $file) ) {
144                 $logger->error("Error opening script file: $file");
145                 return 0;
146         }
147
148         my $js = $self->context;
149
150         my $res = '';
151         {       local $/ = undef;
152
153                 $self->insert('environment.result' => {});
154
155                 my $content = <F>;
156                 #print ( "full script is [$content]" );
157
158                 my $s = time();
159                 if( !$js || !$content || !$js->eval($content) ) {
160                         $logger->error("$file Eval failed: $@");  
161                         return 0;
162                 }
163                 $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
164
165                 if ($_real) {
166                         $self->insert('__' => {'OILS_RESULT' => ''});
167                         $js->eval($__json_js."__.OILS_RESULT = js2JSON(environment.result);");
168                         $res = $self->retrieve('__.OILS_RESULT');
169                 }
170         }
171
172         close(F);
173         $logger->debug( "script result is [$res]" );
174         return JSON->JSON2perl( $res );
175 }
176
177 sub remove_path { 
178         my( $self, $path ) = @_;
179         if (ref($self)) {
180                 if ($self->{_path}{$path}) {
181                         $self->{_path}{$path} = 0;
182                 }
183                 return $self->{_path}{$path};
184         } else {
185                 if ($_paths{$path}) {
186                         $_paths{$path} = 0;
187                 }
188                 return $_paths{$path};
189         }
190 }
191
192 sub add_path { 
193         my( $self, $path ) = @_;
194         if (ref($self)) {
195                 if (!$self->{_path}{$path}) {
196                         $self->{_path}{$path} = 1;
197                 }
198         } else {
199                 if (!$_paths{$path}) {
200                         $_paths{$path} = 1;
201                 }
202         }
203         return $self;
204 }
205
206 sub _find_file {
207         my $self = shift;
208         my $file = shift;
209         for my $p ( keys %{ $self->{_path} } ) {
210                 next unless ($self->{_path}{$p});
211                 my $full = join('/',$p,$file);
212                 return $full if (-e $full);
213         }
214 }
215
216 sub load_lib { 
217         my( $self, $file ) = @_;
218
219         push @{ $self->{libs} }, $file
220                 if (! grep {$_ eq $file} @{ $self->{libs} });
221
222         if (!$self->{_loaded}{$file}) {
223                 $self->run( $file );
224                 $self->{_loaded}{$file} = 1;
225         }
226         return $self->{_loaded}{$file};
227 }
228
229 sub _js_prop_name {
230         my $name = shift;
231         $name =~ s/^.*\.//o;
232         return $name;
233 }
234
235 sub retrieve {
236         my( $self, $key ) = @_;
237         return $self->context->property_get($key);
238 }
239
240 sub insert_method {
241         my( $self, $obj_key, $meth_name, $sub, $stop) = @_;
242
243         push @{$self->{_methods}}, { key => $obj_key => name => $meth_name, meth => $sub } unless ($stop);
244         
245         my $obj = $self->context->object_by_path( $obj_key );
246         $self->context->function_set( $meth_name, $sub, $obj ) if $obj;
247 }
248
249
250 sub insert {
251         my( $self, $key, $val, $RO, $stop ) = @_;
252         return unless defined($key);
253
254         push @{$self->{_env}}, { key => $key => value => $val, readonly => $RO } unless ($stop);
255
256         if (ref($val) =~ /^Fieldmapper/o) {
257                 $self->insert_fm($key, $val, $RO);
258         } elsif (ref($val) and $val =~ /ARRAY/o) {
259                 $self->insert_array($key, $val, $RO);
260         } elsif (ref($val) and $val =~ /HASH/o) {
261                 $self->insert_hash($key, $val, $RO);
262         } elsif (ref($val) and $val =~ /CODE/o) {
263                 $self->context->function_set( $key, $val );
264         } elsif (!ref($val)) {
265                 if( defined($val) ) {
266                         $self->context->property_by_path(
267                                 $key, $val,
268                                 ( !$RO ?  (sub { $val }, sub { my( $k, $v ) = @_; $val = $v; }) : () )
269                         );
270                 } else {
271                         $self->context->property_by_path($key, "");
272                 }
273
274         } else {
275                 return 0;
276         }
277
278         return 1;
279 }
280
281 sub insert_fm {
282
283         my( $self, $key, $fm, $RO ) = @_;
284         my $ctx = $self->context;
285         return undef unless ($ctx and $key and $fm);
286         my $o = $ctx->object_by_path($key);
287         
288         for my $f ( $fm->properties ) {
289                 my $val = $fm->$f();
290                 if (ref $val) {
291                         $self->insert("$key.$f", $val);
292                 } else {
293                         $ctx->property_by_path(
294                                 "$key.$f",
295                                 $val,
296                                 ( !$RO ? 
297                                         (sub {
298                                                 my $k = _js_prop_name(shift());
299                                                 $fm->$k();
300                                         }, 
301                                         sub {
302                                                 my $k = _js_prop_name(shift());
303                                                 $fm->ischanged(1);
304                                                 $fm->$k(@_);
305                                         }) :
306                                         ()
307                                 )
308                         );
309                 }
310         }
311 }
312
313 sub insert_hash {
314
315         my( $self, $key, $hash, $RO ) = @_;
316         my $ctx = $self->context;
317         return undef unless ($ctx and $key and $hash);
318         $ctx->object_by_path($key);
319         
320         for my $k ( keys %$hash ) {
321                 my $v = $hash->{$k};
322                 if (ref $v) {
323                         $self->insert("$key.$k", $v);
324                 } else {
325                         $ctx->property_by_path(
326                                 "$key.$k", $v,
327                                 ( !$RO ? 
328                                         (sub { $hash->{_js_prop_name(shift())} },
329                                         sub {
330                                                 my( $hashkey, $val ) = @_;
331                                                 $hash->{_js_prop_name($hashkey)} = $val;
332                                         }) :
333                                         ()
334                                 )
335                         );
336                 }
337         }
338 }
339
340 my $__array_id = 0;
341 sub insert_array {
342
343         my( $self, $key, $array ) = @_;
344         my $ctx = $self->context;
345         return undef unless ($ctx and $key and $array);
346
347         my $a = $ctx->array_by_path($key);
348         
349         my $ind = 0;
350         for my $v ( @$array ) {
351                 if (ref $v) {
352                         my $tmp_index = $__array_id++;
353                         my $elobj = $ctx->object_by_path('__tmp_arr_el'.$tmp_index);
354                         $self->insert('__tmp_arr_el'.$tmp_index, $v);
355                         $ctx->array_set_element_as_object( $a, $ind, $elobj );
356                 } else {
357                         $ctx->array_set_element( $a, $ind, $v ) if defined($v);
358                 }
359                 $ind++;
360         }
361 }
362
363 sub _xmlhttprequest_send {
364         my $self = shift;
365         my $id = shift;
366         my $method = shift;
367         my $url = shift;
368         my $blocking = shift;
369         my $headerlist = shift;
370         my $data = shift;
371
372         my $ctx = $self->context;
373
374         # just so perl has access to it...
375         $ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
376
377         my $headers = new HTTP::Headers;
378         my @lines = split(/\n/so, $headerlist);
379         for my $line (@lines) {
380                 if ($line =~ /^(.+?)|(.+)$/o) {
381                         $headers->header($1 => $2);
382                 }
383         }
384
385         my $ua = LWP::UserAgent->new;
386         $ua->agent("OpenILS/0.1");
387
388         my $req = HTTP::Request->new($method => $url => $headers => $data);
389         my $res = $ua->request($req);
390
391         if ($res->is_success) {
392                 
393                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
394                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
395                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
396                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
397
398         }
399                 
400 }
401
402 our %_jsonopensrfrequest_cache = ();
403
404 sub _jsonopensrfrequest_connect {
405         my $self = shift;
406         my $id = shift;
407         my $service = shift;
408
409         my $ctx = $self->context;
410         $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
411
412         my $ses = $_jsonopensrfrequest_cache{$id} ||
413                         do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) };
414
415         if($ses->connect) {
416                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 1);
417         } else {
418                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 0);
419         }
420 }
421
422 sub _jsonopensrfrequest_disconnect {
423         my $self = shift;
424         my $id = shift;
425
426         my $ctx = $self->context;
427         $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
428
429         my $ses = $_jsonopensrfrequest_cache{$id};
430         return unless $ses;
431
432         $ses->disconnect;
433 }
434
435 sub _jsonopensrfrequest_finish {
436         my $self = shift;
437         my $id = shift;
438
439         my $ctx = $self->context;
440         $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
441
442         my $ses = $_jsonopensrfrequest_cache{$id};
443         return unless $ses;
444
445         $ses->finish;
446         delete $_jsonopensrfrequest_cache{$id};
447 }
448
449 sub _jsonopensrfrequest_send {
450         my $self = shift;
451         my $id = shift;
452         my $service = shift;
453         my $method = shift;
454         my $blocking = shift;
455         my $params = shift;
456
457         my @p = @{ JSON->JSON2perl($params) };
458
459         my $ctx = $self->context;
460
461         # just so perl has access to it...
462         $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
463
464         my $ses = $_jsonopensrfrequest_cache{$id} ||
465                         do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) };
466         my $req = $ses->request($method,@p);
467
468         $req->wait_complete;
469         if (!$req->failed) {
470                 my $res = $req->recv->content;
471                 
472                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', JSON->perl2JSON($res));
473                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
474                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', 'OK');
475                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', '200');
476
477         } else {
478                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', '');
479                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
480                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', $req->failed->status );
481                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', $req->failed->statusCode );
482         }
483
484         $req->finish;
485                 
486 }
487
488 sub _parse_xml_string {
489         my $self = shift;
490         my $string = shift;
491         my $key = shift;
492
493
494         my $doc;
495         my $s = 0;
496         try {
497                 $doc = XML::LibXML->new->parse_string( $string );
498                 $s = 1;
499         } catch Error with {
500                 my $e = shift;
501                 warn "Could not parse document: $e\n";
502         };
503         return unless ($s);
504
505         _JS_DOM($self->context, $key, $doc);
506 }
507
508 sub _JS_DOM {
509         my $ctx = shift;
510         my $key = shift;
511         my $node = shift;
512
513         if ($node->nodeType == 9) {
514                 $node = $node->documentElement;
515
516                 my $n = $node->nodeName;
517                 my $ns = $node->namespaceURI;
518                 $ns =~ s/'/\'/gso if ($ns);
519                 $ns = "'$ns'" if ($ns);
520                 $ns = 'null' unless ($ns);
521                 $n =~ s/'/\'/gso;
522
523                 #warn("$key = DOMImplementation().createDocument($ns,'$n');");
524                 $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
525
526                 $key = $key.'.documentElement';
527         }
528
529         for my $a ($node->attributes) {
530                 my $n = $a->nodeName;
531                 my $v = $a->value;
532                 $n =~ s/'/\'/gso;
533                 $v =~ s/'/\'/gso;
534                 #warn("$key.setAttribute('$n','$v');");
535                 $ctx->eval("$key.setAttribute('$n','$v');");
536
537         }
538
539         my $k = 0;
540         for my $c ($node->childNodes) {
541                 if ($c->nodeType == 1) {
542                         my $n = $c->nodeName;
543                         my $ns = $node->namespaceURI;
544
545                         $n =~ s/'/\'/gso;
546                         $ns =~ s/'/\'/gso if ($ns);
547                         $ns = "'$ns'" if ($ns);
548                         $ns = 'null' unless ($ns);
549
550                         #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
551                         $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
552                         _JS_DOM($ctx, "$key.childNodes.item($k)",$c);
553
554                 } elsif ($c->nodeType == 3) {
555                         my $n = $c->data;
556                         $n =~ s/'/\'/gso;
557                         #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
558                         #warn("path is $key.item($k);");
559                         $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
560
561                 } elsif ($c->nodeType == 4) {
562                         my $n = $c->data;
563                         $n =~ s/'/\'/gso;
564                         #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
565                         $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
566
567                 } elsif ($c->nodeType == 8) {
568                         my $n = $c->data;
569                         $n =~ s/'/\'/gso;
570                         #warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
571                         $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
572
573                 } else {
574                         warn "ACK! I don't know how to handle node type ".$c->nodeType;
575                 }
576                 
577
578                 $k++;
579         }
580
581         return 1;
582 }
583
584
585
586 1;
587
588 __DATA__
589
590 // in case we run on an implimentation that doesn't have "undefined";
591 var undefined;
592
593 function Cast (obj, class_constructor) {
594         try {
595                 if (eval(class_constructor + '["_isfieldmapper"]')) {
596                         obj = eval("new " + class_constructor + "(obj)");
597                 }
598         } catch( E ) {
599                 alert( E + "\n");
600         } finally {
601                 return obj;
602         }
603 }
604
605 function JSON2js (json) {
606
607         json = String(json).replace( /\/\*--\s*S\w*?\s*?\s+\w+\s*--\*\//g, 'Cast(');
608         json = String(json).replace( /\/\*--\s*E\w*?\s*?\s+(\w+)\s*--\*\//g, ', "$1")');
609
610         var obj;
611         if (json != '') {
612                 try {
613                         eval( 'obj = ' + json );
614                 } catch(E) {
615                         debug("Error building JSON object with string " + E + "\nString:\n" + json );
616                         return null;
617                 }
618         }
619         return obj;
620 }
621
622
623 function object2Array(obj) {
624         if( obj == null ) return null;
625
626         var arr = new Array();
627         for( var i  = 0; i < obj.length; i++ ) {
628                 arr[i] = obj[i];
629         }
630         return arr;
631 }
632
633
634 function js2JSON(arg) {
635         return _js2JSON(arg);
636 }
637
638 function _js2JSON(arg) {
639         var i, o, u, v;
640
641                 switch (typeof arg) {
642                         case 'object':
643         
644                                 if(arg) {
645         
646                                         if (arg._isfieldmapper) { /* magi-c-ast for fieldmapper objects */
647         
648                                                 if( arg.a.constructor != Array ) {
649                                                         var arr = new Array();
650                                                         for( var i  = 0; i < arg.a.length; i++ ) {
651                                                                 if( arg.a[i] == null ) {
652                                                                         arr[i] = null; continue;
653                                                                 }
654         
655                                                                 if( typeof arg.a[i] != 'object' ) { 
656                                                                         arr[i] = arg.a[i];
657         
658                                                                 } else if( typeof arg.a[i] == 'object' 
659                                                                                         && arg.a[i]._isfieldmapper) {
660         
661                                                                         arr[i] = arg.a[i];
662         
663                                                                 } else {
664                                                                         arr[i] = object2Array(arg.a[i]);                
665                                                                 }
666                                                         }
667                                                         arg.a = arr;
668                                                 }
669         
670                                                 return "/*--S " + arg.classname + " --*/" + js2JSON(arg.a) + "/*--E " + arg.classname + " --*/";
671         
672                                         } else {
673         
674                                                 if (arg.constructor == Array) {
675                                                         o = '';
676                                                         for (i = 0; i < arg.length; ++i) {
677                                                                 v = js2JSON(arg[i]);
678                                                                 if (o) {
679                                                                         o += ',';
680                                                                 }
681                                                                 if (v !== u) {
682                                                                         o += v;
683                                                                 } else {
684                                                                         o += 'null';
685                                                                 }
686                                                         }
687                                                         return '[' + o + ']';
688         
689                                                 } else if (typeof arg.toString != 'undefined') {
690                                                         o = '';
691                                                         for (i in arg) {
692                                                                 v = js2JSON(arg[i]);
693                                                                 if (v !== u) {
694                                                                         if (o) {
695                                                                                 o += ',';
696                                                                         }
697                                                                         o += js2JSON(i) + ':' + v;
698                                                                 }
699                                                         }
700         
701                                                         o = '{' + o + '}';
702                                                         return o;
703         
704                                                 } else {
705                                                         return;
706                                                 }
707                                         }
708                                 }
709                                 return 'null';
710         
711                         case 'unknown':
712                         case 'number':
713                                 if( isNaN(arg) ) throw "JSON.js encountered NaN in js2JSON()";
714                                 return arg;
715         
716                         case 'undefined':
717                         case 'function':
718                                 return u;
719         
720                         case 'string':
721                         default:
722                                 return '"' + String(arg).replace(/(["\\])/g, '\\$1') + '"';
723                 }
724
725 }
726