From 5581b68ca183e32aa1f543e35038e297bf02109d Mon Sep 17 00:00:00 2001 From: miker Date: Wed, 18 Jan 2006 05:56:38 +0000 Subject: [PATCH 1/1] first cut of ScriptRunner absorbtion of O::U::SM; readonly flag for insert; eating the insert dog food for adding basic support methods git-svn-id: svn://svn.open-ils.org/ILS/trunk@2740 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- .../perlmods/OpenILS/Utils/ScriptRunner.pm | 420 ++++++++++++++++-- 1 file changed, 395 insertions(+), 25 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm b/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm index edae2c4803..eb7b2ecea3 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm @@ -1,47 +1,417 @@ package OpenILS::Utils::ScriptRunner; use strict; use warnings; use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::SpiderMonkey; +use OpenSRF::EX qw(:try); +use JavaScript::SpiderMonkey; +use LWP::UserAgent; +use XML::LibXML; +use Time::HiRes qw/time/; +use vars qw/%_paths/; -sub new { +sub new { my $class = shift; my %params = @_; $class = ref($class) || $class; + $params{paths} ||= []; + + my $self = bless { file => $params{file}, + libs => $params{libs}, + _path => {%_paths} } => $class; + + $self->add_path($_) for @{$params{paths}}; + return $self->init; +} + +sub context { + my( $self, $context ) = @_; + $self->{ctx} = $context if $context; + return $self->{ctx}; +} + +sub init { + my $self = shift; + $self->context( new JavaScript::SpiderMonkey ); + $self->context->init(); + + + # eating our own dog food with insert + $self->insert(perl_print => sub { print "@_\n"; } ); + $self->insert(perl_warn => sub { warn @_; } ); + $self->insert(log_activity => sub { $logger->activity(@_); return 1;} ); + $self->insert(log_error => sub { $logger->error(@_); return 1;} ); + $self->insert(log_warn => sub { $logger->warn(@_); return 1;} ); + $self->insert(log_info => sub { $logger->info(@_); return 1;} ); + $self->insert(log_debug => sub { $logger->debug(@_); return 1;} ); + $self->insert(log_internal => sub { $logger->internal(@_); return 1;} ); + $self->insert(debug => sub { $logger->debug(@_); return 1;} ); + $self->insert(alert => sub { $logger->warn(@_); return 1;} ); + $self->insert(load_lib => sub { $self->load_lib(@_); }); + + # XML support functions + $self->insert( + _OILS_FUNC_xmlhttprequest_send => sub { $self->_xmlhttprequest_send(@_); }); + $self->insert( + _OILS_FUNC_xml_parse_string => sub { $self->_parse_xml_string(@_); }); + + $self->load_lib($_) for @{$self->{libs}}; + + return $self; +} + +sub refresh_context { + my $self = shift; + $self->context->destroy; + $self->init; +} + +sub load { + my( $self, $filename ) = @_; + $self->{file} = $filename; +} + +sub run { + my $self = shift; + my $file = shift() || $self->{file}; + my $js = $self->context; + + $file = $self->_find_file($file); + + if( ! open(F, $file) ) { + $logger->error("Error opening script file: $file"); + return 0; + } + + { local $/ = undef; + my $content = ; + my $s = time(); + if( !$js || !$content || !$js->eval($content) ) { + $logger->error("$file Eval failed: $@"); + return 0; + } + $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds"); + } + + close(F); + return 1; +} + +sub remove_path { + my( $self, $path ) = @_; + if (ref($self)) { + if ($self->{_path}{$path}) { + $self->{_path}{$path} = 0; + } + return $self->{_path}{$path}; + } else { + if ($_paths{$path}) { + $_paths{$path} = 0; + } + return $_paths{$path}; + } +} + +sub add_path { + my( $self, $path ) = @_; + if (ref($self)) { + if (!$self->{_path}{$path}) { + $self->{_path}{$path} = 1; + } + } else { + if (!$_paths{$path}) { + $_paths{$path} = 1; + } + } + return $self; +} + +sub _find_file { + my $self = shift; + my $file = shift; + for my $p ( keys %{ $self->{_path} } ) { + next unless ($self->{_path}{$p}); + my $full = join('/',$p,$file); + return $full if (-e $full); + } +} + +sub load_lib { + my( $self, $file ) = @_; + if (!$self->{_loaded}{$file} && $self->run( $file )) { + $self->{_loaded}{$file} = 1; + } + return $self->{_loaded}{$file}; +} + +sub _js_prop_name { + my $name = shift; + $name =~ s/^.*\.//o; + return $name; +} + +sub retrieve { + my( $self, $key ) = @_; + return $self->context->property_get($key); +} + +sub insert_method { + my( $self, $obj_key, $meth_name, $sub ) = @_; + my $obj = $self->context->object_by_path( $obj_key ); + $self->context->function_set( $meth_name, $sub, $obj ) if $obj; +} + + +sub insert { + my( $self, $key, $val, $RO ) = @_; + return unless defined($key); - my $type = $params{type} || 'js'; - my $thingy = OpenILS::Utils::SpiderMonkey->new( %params ) if( $type =~ /js/i ); + if (ref($val) =~ /^Fieldmapper/o) { + $self->insert_fm($key, $val, $RO); + } elsif (ref($val) and $val =~ /ARRAY/o) { + $self->insert_array($key, $val, $RO); + } elsif (ref($val) and $val =~ /HASH/o) { + $self->insert_hash($key, $val, $RO); + } elsif (ref($val) and $val =~ /CODE/o) { + $self->context->function_set( $key, $val ); + } elsif (!ref($val)) { + if( defined($val) ) { + $self->context->property_by_path( + $key, $val, + sub { $val }, + ( !$RO ? + sub { my( $k, $v ) = @_; $val = $v; } : + sub{} + ) + ); + } else { + $self->context->property_by_path($key); + } - if($thingy) { - $thingy->init; - return $thingy; + } else { + return 0; + } + + return 1; +} + +sub insert_fm { + + my( $self, $key, $fm, $RO ) = @_; + my $ctx = $self->context; + return undef unless ($ctx and $key and $fm); + my $o = $ctx->object_by_path($key); + + for my $f ( $fm->properties ) { + my $val = $fm->$f(); + if (ref $val) { + $self->insert("$key.$f", $val); + } else { + $ctx->property_by_path( + "$key.$f", + $val, + sub { + my $k = _js_prop_name(shift()); + $fm->$k(); + }, + + ( !$RO ? + sub { + my $k = _js_prop_name(shift()); + $fm->ischanged(1); + $fm->$k(@_); + } : + sub {} + ) + ); + } + } +} + +sub insert_hash { - } else { - $logger->error("Unknown script type in OpenILS::Utils::ScriptRunner"); + my( $self, $key, $hash, $RO ) = @_; + my $ctx = $self->context; + return undef unless ($ctx and $key and $hash); + $ctx->object_by_path($key); + + for my $k ( keys %$hash ) { + my $v = $hash->{$k}; + if (ref $v) { + $self->insert("$key.$k", $v); + } else { + $ctx->property_by_path( + "$key.$k", $v, + sub { $hash->{_js_prop_name(shift())} }, + ( !$RO ? + sub { + my( $hashkey, $val ) = @_; + $hash->{_js_prop_name($hashkey)} = $val; } + } : + sub {} + ) + ); + } } - return undef; } -sub init {$logger->error("METHOD NOT DEFINED"); } +my $__array_id = 0; +sub insert_array { -# the script context -sub context {$logger->error("METHOD NOT DEFINED"); } + my( $self, $key, $array ) = @_; + my $ctx = $self->context; + return undef unless ($ctx and $key and $array); + + my $a = $ctx->array_by_path($key); + + my $ind = 0; + for my $v ( @$array ) { + if (ref $v) { + my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id); + $self->insert('__tmp_arr_el'.$__array_id, $v); + $ctx->array_set_element_as_object( $a, $ind, $elobj ); + $__array_id++; + } else { + $ctx->array_set_element( $a, $ind, $v ) if defined($v); + } + $ind++; + } +} + +sub _xmlhttprequest_send { + my $self = shift; + my $id = shift; + my $method = shift; + my $url = shift; + my $blocking = shift; + my $headerlist = shift; + my $data = shift; + + my $ctx = $self->context; + + # just so perl has access to it... + $ctx->object_by_path('__xmlhttpreq_hash.id'.$id); + + my $headers = new HTTP::Headers; + my @lines = split(/\n/so, $headerlist); + for my $line (@lines) { + if ($line =~ /^(.+?)|(.+)$/o) { + $headers->header($1 => $2); + } + } + + my $ua = LWP::UserAgent->new; + $ua->agent("OpenILS/0.1"); + + my $req = HTTP::Request->new($method => $url => $headers => $data); + my $res = $ua->request($req); + + if ($res->is_success) { + + $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content); + $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4); + $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line); + $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code); + + } + +} -# Retrieves a value based on key -sub retrieve {$logger->error("METHOD NOT DEFINED"); } +sub _parse_xml_string { + my $self = shift; + my $string = shift; + my $key = shift; -# generic insertion method - should work on arrays, -# hashes, fieldmapper objects, and scalars -sub insert {$logger->error("METHOD NOT DEFINED"); } -# loads an external script -sub load { $logger->error("METHOD NOT DEFINED"); } + my $doc; + my $s = 0; + try { + $doc = XML::LibXML->new->parse_string( $string ); + $s = 1; + } catch Error with { + my $e = shift; + warn "Could not parse document: $e\n"; + }; + return unless ($s); + + _JS_DOM($self->context, $key, $doc); +} + +sub _JS_DOM { + my $ctx = shift; + my $key = shift; + my $node = shift; + + if ($node->nodeType == 9) { + $node = $node->documentElement; + + my $n = $node->nodeName; + my $ns = $node->namespaceURI; + $ns =~ s/'/\'/gso if ($ns); + $ns = "'$ns'" if ($ns); + $ns = 'null' unless ($ns); + $n =~ s/'/\'/gso; + + #warn("$key = DOMImplementation().createDocument($ns,'$n');"); + $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');"); + + $key = $key.'.documentElement'; + } + + for my $a ($node->attributes) { + my $n = $a->nodeName; + my $v = $a->value; + $n =~ s/'/\'/gso; + $v =~ s/'/\'/gso; + #warn("$key.setAttribute('$n','$v');"); + $ctx->eval("$key.setAttribute('$n','$v');"); + + } + + my $k = 0; + for my $c ($node->childNodes) { + if ($c->nodeType == 1) { + my $n = $c->nodeName; + my $ns = $node->namespaceURI; + + $n =~ s/'/\'/gso; + $ns =~ s/'/\'/gso if ($ns); + $ns = "'$ns'" if ($ns); + $ns = 'null' unless ($ns); + + #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));"); + $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));"); + _JS_DOM($ctx, "$key.childNodes.item($k)",$c); + + } elsif ($c->nodeType == 3) { + my $n = $c->data; + $n =~ s/'/\'/gso; + #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));"); + #warn("path is $key.item($k);"); + $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));"); + + } elsif ($c->nodeType == 4) { + my $n = $c->data; + $n =~ s/'/\'/gso; + #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));"); + $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));"); + + } elsif ($c->nodeType == 8) { + my $n = $c->data; + $n =~ s/'/\'/gso; + #warn("$key.appendChild($key.ownerDocument.createComment('$n'));"); + $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));"); + + } else { + warn "ACK! I don't know how to handle node type ".$c->nodeType; + } + + + $k++; + } + + return 1; +} -# Runs an external script. -# @return 1 on success, 0 on failure -sub run { $logger->error("METHOD NOT DEFINED"); } -# load an external library -sub load_lib { $logger->error("METHOD NOT DEFINED"); } 1; -- 2.43.2