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/;
  11
  12
  13 sub new {
  14         my $class = shift;
  15         my %params = @_;
  16         $class = ref($class) || $class;
  17         $params{paths} ||= [];
  18
  19         my $self = bless {      file => $params{file},
  20                                 libs => $params{libs},
  21                                 _path => {%_paths} } => $class;
  22
  23         $self->add_path($_) for @{$params{paths}};
  24         return $self->init;
  25 }
  26
  27 sub context {
  28         my( $self, $context ) = @_;
  29         $self->{ctx} = $context if $context;
  30         return $self->{ctx};
  31 }
  32
  33 sub init {
  34         my $self = shift;
  35         $self->context( new JavaScript::SpiderMonkey );
  36         $self->context->init();
  37
  38
  39         # eating our own dog food with insert
  40         $self->insert(perl_print        => sub { print "@_\n"; } );
  41         $self->insert(perl_warn         => sub { warn @_; } );
  42         $self->insert(log_activity      => sub { $logger->activity(@_); return 1;} );
  43         $self->insert(log_error         => sub { $logger->error(@_); return 1;} );
  44         $self->insert(log_warn          => sub { $logger->warn(@_); return 1;} );
  45         $self->insert(log_info          => sub { $logger->info(@_); return 1;} );
  46         $self->insert(log_debug         => sub { $logger->debug(@_); return 1;} );
  47         $self->insert(log_internal      => sub { $logger->internal(@_); return 1;} );
  48         $self->insert(debug             => sub { $logger->debug(@_); return 1;} );
  49         $self->insert(alert             => sub { $logger->warn(@_); return 1;} );
  50         $self->insert(load_lib          => sub { $self->load_lib(@_); });
  51
  52         # OpenSRF support function
  53         $self->insert(
  54                 _OILS_FUNC_jsonopensrfrequest_send =>
  55                         sub { $self->_jsonopensrfrequest_send(@_); }
  56         );
  57
  58         # XML support functions
  59         $self->insert(
  60                 _OILS_FUNC_xmlhttprequest_send  =>
  61                         sub { $self->_xmlhttprequest_send(@_); }
  62         );
  63         $self->insert(
  64                 _OILS_FUNC_xml_parse_string     =>
  65                         sub { $self->_parse_xml_string(@_); }
  66         );
  67
  68         $self->load_lib($_) for @{$self->{libs}};
  69
  70         return $self;
  71 }
  72
  73 sub refresh_context {
  74         my $self = shift;
  75         $self->context->destroy;
  76         $self->{_loaded} = {};
  77         $self->init;
  78 }
  79
  80 sub load {
  81         my( $self, $filename ) = @_;
  82         $self->{file} = $filename;
  83 }
  84
  85 sub run {
  86         my $self = shift;
  87         my $file = shift() || $self->{file};
  88         my $js = $self->context;
  89
  90         $file = $self->_find_file($file);
  91
  92         if( ! open(F, $file) ) {
  93                 $logger->error("Error opening script file: $file");
  94                 return 0;
  95         }
  96
  97         {       local $/ = undef;
  98                 my $content = <F>;
  99                 my $s = time();
 100                 if( !$js || !$content || !$js->eval($content) ) {
 101                         $logger->error("$file Eval failed: $@");
 102                         return 0;
 103                 }
 104                 $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
 105         }
 106
 107         close(F);
 108         return 1;
 109 }
 110
 111 sub remove_path {
 112         my( $self, $path ) = @_;
 113         if (ref($self)) {
 114                 if ($self->{_path}{$path}) {
 115                         $self->{_path}{$path} = 0;
 116                 }
 117                 return $self->{_path}{$path};
 118         } else {
 119                 if ($_paths{$path}) {
 120                         $_paths{$path} = 0;
 121                 }
 122                 return $_paths{$path};
 123         }
 124 }
 125
 126 sub add_path {
 127         my( $self, $path ) = @_;
 128         if (ref($self)) {
 129                 if (!$self->{_path}{$path}) {
 130                         $self->{_path}{$path} = 1;
 131                 }
 132         } else {
 133                 if (!$_paths{$path}) {
 134                         $_paths{$path} = 1;
 135                 }
 136         }
 137         return $self;
 138 }
 139
 140 sub _find_file {
 141         my $self = shift;
 142         my $file = shift;
 143         for my $p ( keys %{ $self->{_path} } ) {
 144                 next unless ($self->{_path}{$p});
 145                 my $full = join('/',$p,$file);
 146                 return $full if (-e $full);
 147         }
 148 }
 149
 150 sub load_lib {
 151         my( $self, $file ) = @_;
 152         if (!$self->{_loaded}{$file} && $self->run( $file )) {
 153                 $self->{_loaded}{$file} = 1;
 154         }
 155         return $self->{_loaded}{$file};
 156 }
 157
 158 sub _js_prop_name {
 159         my $name = shift;
 160         $name =~ s/^.*\.//o;
 161         return $name;
 162 }
 163
 164 sub retrieve {
 165         my( $self, $key ) = @_;
 166         return $self->context->property_get($key);
 167 }
 168
 169 sub insert_method {
 170         my( $self, $obj_key, $meth_name, $sub ) = @_;
 171         my $obj = $self->context->object_by_path( $obj_key );
 172         $self->context->function_set( $meth_name, $sub, $obj ) if $obj;
 173 }
 174
 175
 176 sub insert {
 177         my( $self, $key, $val, $RO ) = @_;
 178         return unless defined($key);
 179
 180         if (ref($val) =~ /^Fieldmapper/o) {
 181                 $self->insert_fm($key, $val, $RO);
 182         } elsif (ref($val) and $val =~ /ARRAY/o) {
 183                 $self->insert_array($key, $val, $RO);
 184         } elsif (ref($val) and $val =~ /HASH/o) {
 185                 $self->insert_hash($key, $val, $RO);
 186         } elsif (ref($val) and $val =~ /CODE/o) {
 187                 $self->context->function_set( $key, $val );
 188         } elsif (!ref($val)) {
 189                 if( defined($val) ) {
 190                         $self->context->property_by_path(
 191                                 $key, $val,
 192                                 sub { $val },
 193                                 ( !$RO ?
 194                                         sub { my( $k, $v ) = @_; $val = $v; } :
 195                                         sub{}
 196                                 )
 197                         );
 198                 } else {
 199                         $self->context->property_by_path($key, "");
 200                 }
 201
 202         } else {
 203                 return 0;
 204         }
 205
 206         return 1;
 207 }
 208
 209 sub insert_fm {
 210
 211         my( $self, $key, $fm, $RO ) = @_;
 212         my $ctx = $self->context;
 213         return undef unless ($ctx and $key and $fm);
 214         my $o = $ctx->object_by_path($key);
 215
 216         for my $f ( $fm->properties ) {
 217                 my $val = $fm->$f();
 218                 if (ref $val) {
 219                         $self->insert("$key.$f", $val);
 220                 } else {
 221                         $ctx->property_by_path(
 222                                 "$key.$f",
 223                                 $val,
 224                                 sub {
 225                                         my $k = _js_prop_name(shift());
 226                                         $fm->$k();
 227                                 },
 228
 229                                 ( !$RO ?
 230                                         sub {
 231                                                 my $k = _js_prop_name(shift());
 232                                                 $fm->ischanged(1);
 233                                                 $fm->$k(@_);
 234                                         } :
 235                                         sub {}
 236                                 )
 237                         );
 238                 }
 239         }
 240 }
 241
 242 sub insert_hash {
 243
 244         my( $self, $key, $hash, $RO ) = @_;
 245         my $ctx = $self->context;
 246         return undef unless ($ctx and $key and $hash);
 247         $ctx->object_by_path($key);
 248
 249         for my $k ( keys %$hash ) {
 250                 my $v = $hash->{$k};
 251                 if (ref $v) {
 252                         $self->insert("$key.$k", $v);
 253                 } else {
 254                         $ctx->property_by_path(
 255                                 "$key.$k", $v,
 256                                 sub { $hash->{_js_prop_name(shift())} },
 257                                 ( !$RO ?
 258                                         sub {
 259                                                 my( $hashkey, $val ) = @_;
 260                                                 $hash->{_js_prop_name($hashkey)} = $val;
 261                                         } :
 262                                         sub {}
 263                                 )
 264                         );
 265                 }
 266         }
 267 }
 268
 269 my $__array_id = 0;
 270 sub insert_array {
 271
 272         my( $self, $key, $array ) = @_;
 273         my $ctx = $self->context;
 274         return undef unless ($ctx and $key and $array);
 275
 276         my $a = $ctx->array_by_path($key);
 277
 278         my $ind = 0;
 279         for my $v ( @$array ) {
 280                 if (ref $v) {
 281                         my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id);
 282                         $self->insert('__tmp_arr_el'.$__array_id, $v);
 283                         $ctx->array_set_element_as_object( $a, $ind, $elobj );
 284                         $__array_id++;
 285                 } else {
 286                         $ctx->array_set_element( $a, $ind, $v ) if defined($v);
 287                 }
 288                 $ind++;
 289         }
 290 }
 291
 292 sub _xmlhttprequest_send {
 293         my $self = shift;
 294         my $id = shift;
 295         my $method = shift;
 296         my $url = shift;
 297         my $blocking = shift;
 298         my $headerlist = shift;
 299         my $data = shift;
 300
 301         my $ctx = $self->context;
 302
 303         # just so perl has access to it...
 304         $ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
 305
 306         my $headers = new HTTP::Headers;
 307         my @lines = split(/\n/so, $headerlist);
 308         for my $line (@lines) {
 309                 if ($line =~ /^(.+?)|(.+)$/o) {
 310                         $headers->header($1 => $2);
 311                 }
 312         }
 313
 314         my $ua = LWP::UserAgent->new;
 315         $ua->agent("OpenILS/0.1");
 316
 317         my $req = HTTP::Request->new($method => $url => $headers => $data);
 318         my $res = $ua->request($req);
 319
 320         if ($res->is_success) {
 321
 322                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
 323                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
 324                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
 325                 $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
 326
 327         }
 328
 329 }
 330
 331 sub _jsonopensrfrequest_send {
 332         my $self = shift;
 333         my $id = shift;
 334         my $service = shift;
 335         my $method = shift;
 336         my $blocking = shift;
 337         my $params = shift;
 338
 339         my @p = @{ JSON->JSON2perl($params) };
 340
 341         my $ctx = $self->context;
 342
 343         # just so perl has access to it...
 344         $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
 345
 346         my $ses = OpenSRF::AppSession->create($service);
 347         my $req = $ses->request($method,@p);
 348
 349         $req->wait_complete;
 350         if (!$req->failed) {
 351                 my $res = $req->content;
 352
 353                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', $res);
 354                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
 355                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', 'OK');
 356                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', '200');
 357
 358         } else {
 359                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', '');
 360                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
 361                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', $req->failed->status );
 362                 $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', $req->failed->statusCode );
 363         }
 364
 365         $req->finish;
 366
 367 }
 368
 369 sub _parse_xml_string {
 370         my $self = shift;
 371         my $string = shift;
 372         my $key = shift;
 373
 374
 375         my $doc;
 376         my $s = 0;
 377         try {
 378                 $doc = XML::LibXML->new->parse_string( $string );
 379                 $s = 1;
 380         } catch Error with {
 381                 my $e = shift;
 382                 warn "Could not parse document: $e\n";
 383         };
 384         return unless ($s);
 385
 386         _JS_DOM($self->context, $key, $doc);
 387 }
 388
 389 sub _JS_DOM {
 390         my $ctx = shift;
 391         my $key = shift;
 392         my $node = shift;
 393
 394         if ($node->nodeType == 9) {
 395                 $node = $node->documentElement;
 396
 397                 my $n = $node->nodeName;
 398                 my $ns = $node->namespaceURI;
 399                 $ns =~ s/'/\'/gso if ($ns);
 400                 $ns = "'$ns'" if ($ns);
 401                 $ns = 'null' unless ($ns);
 402                 $n =~ s/'/\'/gso;
 403
 404                 #warn("$key = DOMImplementation().createDocument($ns,'$n');");
 405                 $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
 406
 407                 $key = $key.'.documentElement';
 408         }
 409
 410         for my $a ($node->attributes) {
 411                 my $n = $a->nodeName;
 412                 my $v = $a->value;
 413                 $n =~ s/'/\'/gso;
 414                 $v =~ s/'/\'/gso;
 415                 #warn("$key.setAttribute('$n','$v');");
 416                 $ctx->eval("$key.setAttribute('$n','$v');");
 417
 418         }
 419
 420         my $k = 0;
 421         for my $c ($node->childNodes) {
 422                 if ($c->nodeType == 1) {
 423                         my $n = $c->nodeName;
 424                         my $ns = $node->namespaceURI;
 425
 426                         $n =~ s/'/\'/gso;
 427                         $ns =~ s/'/\'/gso if ($ns);
 428                         $ns = "'$ns'" if ($ns);
 429                         $ns = 'null' unless ($ns);
 430
 431                         #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
 432                         $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
 433                         _JS_DOM($ctx, "$key.childNodes.item($k)",$c);
 434
 435                 } elsif ($c->nodeType == 3) {
 436                         my $n = $c->data;
 437                         $n =~ s/'/\'/gso;
 438                         #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
 439                         #warn("path is $key.item($k);");
 440                         $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
 441
 442                 } elsif ($c->nodeType == 4) {
 443                         my $n = $c->data;
 444                         $n =~ s/'/\'/gso;
 445                         #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
 446                         $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
 447
 448                 } elsif ($c->nodeType == 8) {
 449                         my $n = $c->data;
 450                         $n =~ s/'/\'/gso;
 451                         #warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
 452                         $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
 453
 454                 } else {
 455                         warn "ACK! I don't know how to handle node type ".$c->nodeType;
 456                 }
 457
 458
 459                 $k++;
 460         }
 461
 462         return 1;
 463 }
 464
 465
 466
 467 1;