1 package OpenILS::Utils::SpiderMonkey;
2 use strict; use warnings;
3 use OpenSRF::Utils::Logger qw(:logger);
4 use OpenSRF::EX qw(:try);
5 use OpenILS::Utils::ScriptRunner;
6 use base 'OpenILS::Utils::ScriptRunner';
7 use JavaScript::SpiderMonkey;
10 use Time::HiRes qw/time/;
14 my ( $class, %params ) = @_;
15 $class = ref($class) || $class;
16 $params{paths} ||= [];
18 my $self = { file => $params{file}, libs => $params{libs}, _path => {%_paths} };
19 bless( $self, $class );
21 $self->add_path($_) for @{$params{paths}};
26 my( $self, $context ) = @_;
27 $self->{ctx} = $context if $context;
33 my $js = JavaScript::SpiderMonkey->new();
36 $js->function_set(perl_print => sub { print "@_\n"; } );
37 $js->function_set(perl_warn => sub { warn @_; } );
38 $js->function_set(log_activity => sub { $logger->activity(@_); return 1;} );
39 $js->function_set(log_error => sub { $logger->error(@_); return 1;} );
40 $js->function_set(log_warn => sub { $logger->warn(@_); return 1;} );
41 $js->function_set(log_info => sub { $logger->info(@_); return 1;} );
42 $js->function_set(log_debug => sub { $logger->debug(@_); return 1;} );
43 $js->function_set(log_internal => sub { $logger->internal(@_); return 1;} );
44 $js->function_set(debug => sub { $logger->debug(@_); return 1;} );
45 $js->function_set(alert => sub { $logger->warn(@_); return 1;} );
47 $js->function_set(load_lib => sub { $self->load_lib(@_); });
49 # XML support functions
51 _OILS_FUNC_xmlhttprequest_send => sub { $self->_xmlhttprequest_send(@_); });
53 _OILS_FUNC_xml_parse_string => sub { $self->_parse_xml_string(@_); });
56 $self->load_lib($_) for @{$self->{libs}};
63 my( $self, $filename ) = @_;
64 $self->{file} = $filename;
69 my $file = shift() || $self->{file};
70 my $js = $self->context;
72 $file = $self->_find_file($file);
74 if( ! open(F, $file) ) {
75 $logger->error("Error opening script file: $file");
82 if( !$js || !$content || !$js->eval($content) ) {
83 $logger->error("$file Eval failed: $@");
86 $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
94 my( $self, $path ) = @_;
96 if ($self->{_path}{$path}) {
97 $self->{_path}{$path} = 0;
99 return $self->{_path}{$path};
101 if ($_paths{$path}) {
104 return $_paths{$path};
109 my( $self, $path ) = @_;
111 if (!$self->{_path}{$path}) {
112 $self->{_path}{$path} = 1;
115 if (!$_paths{$path}) {
125 for my $p ( keys %{ $self->{_path} } ) {
126 next unless ($self->{_path}{$p});
127 my $full = join('/',$p,$file);
128 return $full if (-e $full);
133 my( $self, $file ) = @_;
134 if (!$self->{_loaded}{$file} && $self->run( $file )) {
135 $self->{_loaded}{$file} = 1;
137 return $self->{_loaded}{$file};
147 my( $self, $key ) = @_;
148 return $self->context->property_get($key);
152 my( $self, $obj_key, $meth_name, $sub ) = @_;
153 my $obj = $self->context->object_by_path( $obj_key );
154 $self->context->function_set( $meth_name, $sub, $obj ) if $obj;
159 my( $self, $key, $val ) = @_;
160 return unless defined($key);
162 if (ref($val) =~ /^Fieldmapper/o) {
163 $self->insert_fm($key, $val);
164 } elsif (ref($val) and $val =~ /ARRAY/o) {
165 $self->insert_array($key, $val);
166 } elsif (ref($val) and $val =~ /HASH/o) {
167 $self->insert_hash($key, $val);
168 } elsif (ref($val) and $val =~ /CODE/o) {
169 $self->context->function_set( $key, $val );
170 } elsif (!ref($val)) {
171 if( defined($val) ) {
172 $self->context->property_by_path(
175 sub { my( $k, $v ) = @_; $val = $v; }
178 $self->context->property_by_path($key);
190 my( $self, $key, $fm ) = @_;
191 my $ctx = $self->context;
192 return undef unless ($ctx and $key and $fm);
193 my $o = $ctx->object_by_path($key);
195 for my $f ( $fm->properties ) {
198 $self->insert("$key.$f", $val);
200 $ctx->property_by_path(
204 my $k = _js_prop_name(shift());
209 my $k = _js_prop_name(shift());
220 my( $self, $key, $hash ) = @_;
221 my $ctx = $self->context;
222 return undef unless ($ctx and $key and $hash);
223 $ctx->object_by_path($key);
225 for my $k ( keys %$hash ) {
228 $self->insert("$key.$k", $v);
230 $ctx->property_by_path(
232 sub { $hash->{_js_prop_name(shift())} },
234 my( $key, $val ) = @_;
235 $hash->{_js_prop_name($key)} = $val; }
244 my( $self, $key, $array ) = @_;
245 my $ctx = $self->context;
246 return undef unless ($ctx and $key and $array);
248 my $a = $ctx->array_by_path($key);
251 for my $v ( @$array ) {
253 my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id);
254 $self->insert('__tmp_arr_el'.$__array_id, $v);
255 $ctx->array_set_element_as_object( $a, $ind, $elobj );
258 $ctx->array_set_element( $a, $ind, $v ) if defined($v);
264 sub _xmlhttprequest_send {
269 my $blocking = shift;
270 my $headerlist = shift;
273 my $ctx = $self->context;
275 # just so perl has access to it...
276 $ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
278 my $headers = new HTTP::Headers;
279 my @lines = split(/\n/so, $headerlist);
280 for my $line (@lines) {
281 if ($line =~ /^(.+?)|(.+)$/o) {
282 $headers->header($1 => $2);
286 my $ua = LWP::UserAgent->new;
287 $ua->agent("OpenILS/0.1");
289 my $req = HTTP::Request->new($method => $url => $headers => $data);
290 my $res = $ua->request($req);
292 if ($res->is_success) {
294 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
295 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
296 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
297 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
303 sub _parse_xml_string {
312 $doc = XML::LibXML->new->parse_string( $string );
316 warn "Could not parse document: $e\n";
320 _JS_DOM($self->context, $key, $doc);
328 if ($node->nodeType == 9) {
329 $node = $node->documentElement;
331 my $n = $node->nodeName;
332 my $ns = $node->namespaceURI;
333 $ns =~ s/'/\'/gso if ($ns);
334 $ns = "'$ns'" if ($ns);
335 $ns = 'null' unless ($ns);
338 #warn("$key = DOMImplementation().createDocument($ns,'$n');");
339 $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
341 $key = $key.'.documentElement';
344 for my $a ($node->attributes) {
345 my $n = $a->nodeName;
349 #warn("$key.setAttribute('$n','$v');");
350 $ctx->eval("$key.setAttribute('$n','$v');");
355 for my $c ($node->childNodes) {
356 if ($c->nodeType == 1) {
357 my $n = $c->nodeName;
358 my $ns = $node->namespaceURI;
361 $ns =~ s/'/\'/gso if ($ns);
362 $ns = "'$ns'" if ($ns);
363 $ns = 'null' unless ($ns);
365 #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
366 $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
367 _JS_DOM($ctx, "$key.childNodes.item($k)",$c);
369 } elsif ($c->nodeType == 3) {
372 #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
373 #warn("path is $key.item($k);");
374 $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
376 } elsif ($c->nodeType == 4) {
379 #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
380 $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
382 } elsif ($c->nodeType == 8) {
385 #warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
386 $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
389 warn "ACK! I don't know how to handle node type ".$c->nodeType;