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 OpenSRF::Utils::JSON;
6 use JavaScript::SpiderMonkey;
9 use Time::HiRes qw/time/;
14 $logger->info("script_runner: destroying self: $self");
19 $logger->info("script_runner: destroying context...");
20 $runner->context->destroy;
21 delete($$runner{$_}) for (keys %$runner);
27 $class = ref($class) || $class;
28 $params{paths} ||= [];
29 $params{reset_count} ||= 0;
31 my $self = bless { file => $params{file},
32 libs => $params{libs},
33 reset_count => $params{reset_count},
35 _path => {%_paths} } => $class;
37 $self->add_path($_) for @{$params{paths}};
42 my( $self, $context ) = @_;
43 $self->{ctx} = $context if $context;
49 $self->context( new JavaScript::SpiderMonkey );
50 $self->context->init();
54 # eating our own dog food with insert
55 $self->insert(log_stdout => sub { print "@_\n"; } );
56 $self->insert(log_stderr => sub { warn "@_\n"; } );
57 $self->insert(log_activity => sub { $logger->activity("script_runner: @_"); return 1;} );
58 $self->insert(log_error => sub { $logger->error("script_runner: @_"); return 1;} );
59 $self->insert(log_warn => sub { $logger->warn("script_runner: @_"); return 1;} );
60 $self->insert(log_info => sub { $logger->info("script_runner: @_"); return 1;} );
61 $self->insert(log_debug => sub { $logger->debug("script_runner: @_"); return 1;} );
62 $self->insert(log_internal => sub { $logger->internal("script_runner: @_"); return 1;} );
63 $self->insert(debug => sub { $logger->debug("script_runner: @_"); return 1;} );
64 $self->insert(alert => sub { $logger->warn("script_runner: @_"); return 1;} );
65 $self->insert(load_lib => sub { $self->load_lib(@_); return 1;});
67 # OpenSRF support functions
69 _OILS_FUNC_jsonopensrfrequest_send =>
70 sub { $self->_jsonopensrfrequest_send(@_); }
73 _OILS_FUNC_jsonopensrfrequest_connect =>
74 sub { $self->_jsonopensrfrequest_connect(@_); }
77 _OILS_FUNC_jsonopensrfrequest_disconnect =>
78 sub { $self->_jsonopensrfrequest_disconnect(@_); }
81 _OILS_FUNC_jsonopensrfrequest_finish =>
82 sub { $self->_jsonopensrfrequest_finish(@_); }
85 # XML support functions
87 _OILS_FUNC_xmlhttprequest_send =>
88 sub { $self->_xmlhttprequest_send(@_); }
91 _OILS_FUNC_xml_parse_string =>
92 sub { $self->_parse_xml_string(@_); }
95 while ( my $e = shift @{$self->{_env}} ) {
96 $self->insert( @$e{ qw/key value readonly/ } => 1 );
99 while ( my $e = shift @{$self->{_methods}} ) {
100 $self->insert_method( @$e{ qw/key name meth/ } => 1 );
103 $self->load_lib($_) for @{$self->{libs}};
108 sub refresh_context {
110 $logger->debug("Refreshing JavaScript Context...");
111 $self->context->destroy;
112 $logger->debug("Context destroyed");
113 $self->{_loaded} = {};
114 $logger->debug("Loaded scripts removed");
116 $logger->debug("New Context initialized");
121 my( $self, $filename ) = @_;
122 $self->{file} = $filename;
125 sub runs { shift()->{_runs} }
131 $self->{reset_count} = $count if ($count);
132 return $self->{reset_count};
142 $file = $self->{file};
145 $self->refresh_context
146 if ($self->reset_count && $self->runs > $self->reset_count);
148 $self->{_runs}++ if ($_real);
150 $file = $self->_find_file($file);
151 $logger->debug("full script file path: $file");
153 if( ! open(F, $file) ) {
154 $logger->error("Error opening script file: $file");
158 my $js = $self->context;
163 $self->insert('environment.result' => {});
166 #print ( "full script is [$content]" );
169 if( !$js || !$content || !$js->eval($content) ) {
170 $logger->error("$file Eval failed: $@");
173 $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
176 $self->insert('__' => {'OILS_RESULT' => ''});
177 $js->eval("__.OILS_RESULT = js2JSON(environment.result);");
178 $res = $self->retrieve('__.OILS_RESULT');
183 $logger->debug( "script result is [$res]" );
184 return OpenSRF::Utils::JSON->JSON2perl( $res );
188 my( $self, $path ) = @_;
190 if ($self->{_path}{$path}) {
191 $self->{_path}{$path} = 0;
193 return $self->{_path}{$path};
195 if ($_paths{$path}) {
198 return $_paths{$path};
203 my( $self, $path ) = @_;
205 if (!$self->{_path}{$path}) {
206 $self->{_path}{$path} = 1;
209 if (!$_paths{$path}) {
219 for my $p ( keys %{ $self->{_path} } ) {
220 next unless ($self->{_path}{$p});
221 my $full = join('/',$p,$file);
222 return $full if (-e $full);
227 my( $self, $file ) = @_;
229 my @paths = keys %{$self->{_path}};
230 $logger->debug("script_runner: Loading lib file $file : paths=[@paths]");
232 push @{ $self->{libs} }, $file
233 if (! grep {$_ eq $file} @{ $self->{libs} });
235 if (!$self->{_loaded}{$file}) {
237 $self->{_loaded}{$file} = 1;
239 return $self->{_loaded}{$file};
249 my( $self, $key ) = @_;
250 return $self->context->property_get($key);
254 my( $self, $obj_key, $meth_name, $sub, $stop) = @_;
256 push @{$self->{_methods}}, { key => $obj_key => name => $meth_name, meth => $sub } unless ($stop);
258 my $obj = $self->context->object_by_path( $obj_key );
259 $self->context->function_set( $meth_name, $sub, $obj ) if $obj;
264 my( $self, $key, $val, $RO, $stop ) = @_;
265 return unless defined($key);
267 push @{$self->{_env}}, { key => $key => value => $val, readonly => $RO } unless ($stop);
269 if (ref($val) =~ /^Fieldmapper/o) {
270 $self->insert_fm($key, $val, $RO);
271 } elsif (ref($val) and $val =~ /ARRAY/o) {
272 $self->insert_array($key, $val, $RO);
273 } elsif (ref($val) and $val =~ /HASH/o) {
274 $self->insert_hash($key, $val, $RO);
275 } elsif (ref($val) and $val =~ /CODE/o) {
276 $self->context->function_set( $key, $val );
277 } elsif (!ref($val)) {
278 if( defined($val) ) {
279 $self->context->property_by_path(
281 ( !$RO ? (sub { $val }, sub { my( $k, $v ) = @_; $val = $v; }) : () )
284 $self->context->property_by_path($key, "");
296 my( $self, $key, $fm, $RO ) = @_;
297 my $ctx = $self->context;
298 return undef unless ($ctx and $key and $fm);
299 my $o = $ctx->object_by_path($key);
301 for my $f ( $fm->properties ) {
304 $self->insert("$key.$f", $val);
306 $ctx->property_by_path(
311 my $k = _js_prop_name(shift());
315 my $k = _js_prop_name(shift());
328 my( $self, $key, $hash, $RO ) = @_;
329 my $ctx = $self->context;
330 return undef unless ($ctx and $key and $hash);
331 $ctx->object_by_path($key);
333 for my $k ( keys %$hash ) {
336 $self->insert("$key.$k", $v);
338 $ctx->property_by_path(
341 (sub { $hash->{_js_prop_name(shift())} },
343 my( $hashkey, $val ) = @_;
344 $hash->{_js_prop_name($hashkey)} = $val;
356 my( $self, $key, $array ) = @_;
357 my $ctx = $self->context;
358 return undef unless ($ctx and $key and $array);
360 my $a = $ctx->array_by_path($key);
363 for my $v ( @$array ) {
365 my $tmp_index = $__array_id++;
366 my $elobj = $ctx->object_by_path('__tmp_arr_el'.$tmp_index);
367 $self->insert('__tmp_arr_el'.$tmp_index, $v);
368 $ctx->array_set_element_as_object( $a, $ind, $elobj );
370 $ctx->array_set_element( $a, $ind, $v ) if defined($v);
376 sub _xmlhttprequest_send {
381 my $blocking = shift;
382 my $headerlist = shift;
385 my $ctx = $self->context;
387 # just so perl has access to it...
388 $ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
390 my $headers = new HTTP::Headers;
391 my @lines = split(/\n/so, $headerlist);
392 for my $line (@lines) {
393 if ($line =~ /^(.+?)|(.+)$/o) {
394 $headers->header($1 => $2);
398 my $ua = LWP::UserAgent->new;
399 $ua->agent("OpenILS/0.1");
401 my $req = HTTP::Request->new($method => $url => $headers => $data);
402 my $res = $ua->request($req);
404 if ($res->is_success) {
406 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
407 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
408 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
409 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
415 our %_jsonopensrfrequest_cache = ();
417 sub _jsonopensrfrequest_connect {
422 my $ctx = $self->context;
423 $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
425 my $ses = $_jsonopensrfrequest_cache{$id} ||
426 do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) };
429 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 1);
431 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 0);
435 sub _jsonopensrfrequest_disconnect {
439 my $ctx = $self->context;
440 $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
442 my $ses = $_jsonopensrfrequest_cache{$id};
448 sub _jsonopensrfrequest_finish {
452 my $ctx = $self->context;
453 $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
455 my $ses = $_jsonopensrfrequest_cache{$id};
459 delete $_jsonopensrfrequest_cache{$id};
462 sub _jsonopensrfrequest_send {
467 my $blocking = shift;
470 my @p = @{ OpenSRF::Utils::JSON->JSON2perl($params) };
472 my $ctx = $self->context;
474 # just so perl has access to it...
475 $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
477 my $ses = $_jsonopensrfrequest_cache{$id} ||
478 do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) };
479 my $req = $ses->request($method,@p);
483 my $res = $req->recv->content;
485 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', OpenSRF::Utils::JSON->perl2JSON($res));
486 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
487 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', 'OK');
488 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', '200');
491 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', '');
492 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
493 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', $req->failed->status );
494 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', $req->failed->statusCode );
501 sub _parse_xml_string {
510 $doc = XML::LibXML->new->parse_string( $string );
514 warn "Could not parse document: $e\n";
518 _JS_DOM($self->context, $key, $doc);
526 if ($node->nodeType == 9) {
527 $node = $node->documentElement;
529 my $n = $node->nodeName;
530 my $ns = $node->namespaceURI;
531 $ns =~ s/'/\'/gso if ($ns);
532 $ns = "'$ns'" if ($ns);
533 $ns = 'null' unless ($ns);
536 #warn("$key = DOMImplementation().createDocument($ns,'$n');");
537 $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
539 $key = $key.'.documentElement';
542 for my $a ($node->attributes) {
543 my $n = $a->nodeName;
547 #warn("$key.setAttribute('$n','$v');");
548 $ctx->eval("$key.setAttribute('$n','$v');");
553 for my $c ($node->childNodes) {
554 if ($c->nodeType == 1) {
555 my $n = $c->nodeName;
556 my $ns = $node->namespaceURI;
559 $ns =~ s/'/\'/gso if ($ns);
560 $ns = "'$ns'" if ($ns);
561 $ns = 'null' unless ($ns);
563 #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
564 $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
565 _JS_DOM($ctx, "$key.childNodes.item($k)",$c);
567 } elsif ($c->nodeType == 3) {
570 #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
571 #warn("path is $key.item($k);");
572 $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
574 } elsif ($c->nodeType == 4) {
577 #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
578 $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
580 } elsif ($c->nodeType == 8) {
583 #warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
584 $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
587 warn "ACK! I don't know how to handle node type ".$c->nodeType;