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