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