Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Event.pm

   1 package OpenILS::Application::Trigger::Event;
   2 use strict; use warnings;
   3 use OpenSRF::EX qw/:try/;
   4 use OpenSRF::Utils::JSON;
   5 use OpenSRF::Utils::Logger qw/$logger/;
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Utils::CStoreEditor q/:funcs/;
   8 use OpenILS::Application::Trigger::ModRunner;
   9 use Safe;
  10
  11 my $log = 'OpenSRF::Utils::Logger';
  12
  13 sub new {
  14     my $class = shift;
  15     my $id = shift;
  16     my $editor = shift;
  17     $class = ref($class) || $class;
  18
  19     my $standalone = $editor ? 0 : 1;
  20     $editor ||= new_editor();
  21
  22     if (ref($id) && ref($id) eq $class) {
  23         $id->environment->{EventProcessor} = $id
  24              if ($id->environment->{complete}); # in case it came over an opensrf tube
  25         $id->editor( $editor );
  26         $id->standalone( $standalone );
  27         return $id;
  28     }
  29
  30     my $self = bless { id => $id, editor => $editor, standalone => $standalone } => $class;
  31
  32     return $self->init()
  33 }
  34
  35 sub init {
  36     my $self = shift;
  37     my $id = shift;
  38
  39     return $self if ($self->event);
  40
  41     $self->id( $id );
  42     $self->environment( {} );
  43
  44     if (!$self->id) {
  45         $log->error("No Event ID provided");
  46         die "No Event ID provided";
  47     }
  48
  49     return $self if (!$self->id);
  50
  51     if ($self->standalone) {
  52         $self->editor->xact_begin || return undef;
  53     }
  54
  55     $self->event(
  56         $self->editor->retrieve_action_trigger_event([
  57             $self->id, {
  58                 flesh => 2,
  59                 flesh_fields => {
  60                     atev    => [ qw/event_def/ ],
  61                     atevdef => [ qw/hook env params/ ]
  62                 }
  63             }
  64         ])
  65     );
  66
  67     if ($self->standalone) {
  68         $self->editor->xact_rollback || return undef;
  69     }
  70
  71     $self->user_data(OpenSRF::Utils::JSON->JSON2perl( $self->event->user_data ))
  72         if (defined( $self->event->user_data ));
  73
  74     if ($self->event->state eq 'valid') {
  75         $self->valid(1);
  76     } elsif ($self->event->state eq 'invalid') {
  77         $self->valid(0);
  78     } elsif ($self->event->state eq 'reacting') {
  79         $self->valid(1);
  80     } elsif ($self->event->state eq 'reacted') {
  81         $self->valid(1);
  82         $self->reacted(1);
  83     } elsif ($self->event->state eq 'cleaning') {
  84         $self->valid(1);
  85         $self->reacted(1);
  86     } elsif ($self->event->state eq 'complete') {
  87         $self->valid(1);
  88         $self->reacted(1);
  89         $self->cleanedup(1);
  90     } elsif ($self->event->state eq 'error') {
  91         $self->valid(0);
  92         $self->reacted(0);
  93         $self->cleanedup(0);
  94     }
  95
  96
  97     $self->update_state('found') || die 'Unable to update event state';
  98
  99     my $class = $self->_fm_class_by_hint( $self->event->event_def->hook->core_type );
 100
 101     my $meth = "retrieve_" . $class;
 102     $meth =~ s/Fieldmapper:://;
 103     $meth =~ s/::/_/;
 104
 105     if ($self->standalone) {
 106         $self->editor->xact_begin || return undef;
 107     }
 108
 109     $self->target( $self->editor->$meth( $self->event->target ) );
 110
 111     if ($self->standalone) {
 112         $self->editor->xact_rollback || return undef;
 113     }
 114
 115     unless($self->target) {
 116         $self->update_state('invalid');
 117         $self->valid(0);
 118     }
 119
 120     return $self;
 121 }
 122
 123 sub cleanup {
 124     my $self = shift;
 125     my $env = shift || $self->environment;
 126
 127     return $self if (defined $self->cleanedup);
 128
 129     if (defined $self->reacted) {
 130         $self->update_state( 'cleaning') || die 'Unable to update event state';
 131         try {
 132             my $cleanup = $self->reacted ? $self->event->event_def->cleanup_success : $self->event->event_def->cleanup_failure;
 133             if($cleanup) {
 134                 $self->cleanedup(
 135                     OpenILS::Application::Trigger::ModRunner::Cleanup
 136                         ->new( $cleanup, $env)
 137                         ->run
 138                         ->final_result
 139                 );
 140             } else {
 141                 $self->cleanedup(1);
 142             }
 143         } otherwise {
 144             $log->error("Event cleanup failed with ". shift() );
 145             $self->update_state( 'error' ) || die 'Unable to update event state';
 146         };
 147
 148         if ($self->cleanedup) {
 149             $self->update_state( 'complete' ) || die 'Unable to update event state';
 150         } else {
 151             $self->update_state( 'error' ) || die 'Unable to update event state';
 152         }
 153
 154     } else {
 155         $self->{cleanedup} = undef;
 156     }
 157     return $self;
 158 }
 159
 160 sub react {
 161     my $self = shift;
 162     my $env = shift || $self->environment;
 163
 164     return $self if (defined $self->reacted);
 165
 166     if ($self->valid) {
 167         if ($self->event->event_def->group_field) { # can't react individually to a grouped definition
 168             $self->{reacted} = undef;
 169         } else {
 170             $self->update_state( 'reacting') || die 'Unable to update event state';
 171             try {
 172                 $self->reacted(
 173                     OpenILS::Application::Trigger::ModRunner::Reactor
 174                         ->new( $self->event->event_def->reactor, $env )
 175                         ->run
 176                         ->final_result
 177                 );
 178             } otherwise {
 179                 $log->error("Event reacting failed with ". shift() );
 180                 $self->update_state( 'error' ) || die 'Unable to update event state';
 181             };
 182
 183             if (defined $self->reacted) {
 184                 $self->update_state( 'reacted' ) || die 'Unable to update event state';
 185             } else {
 186                 $self->update_state( 'error' ) || die 'Unable to update event state';
 187             }
 188         }
 189     } else {
 190         $self->{reacted} = undef;
 191     }
 192     return $self;
 193 }
 194
 195 sub validate {
 196     my $self = shift;
 197
 198     return $self if (defined $self->valid);
 199
 200     if ($self->build_environment->environment->{complete}) {
 201         $self->update_state( 'validating') || die 'Unable to update event state';
 202         try {
 203             $self->valid(
 204                 OpenILS::Application::Trigger::ModRunner::Validator
 205                     ->new( $self->event->event_def->validator, $self->environment )
 206                     ->run
 207                     ->final_result
 208             );
 209         } otherwise {
 210             $log->error("Event validation failed with ". shift() );
 211             $self->update_state( 'error' ) || die 'Unable to update event state';
 212         };
 213
 214         if (defined $self->valid) {
 215             if ($self->valid) {
 216                 $self->update_state( 'valid' ) || die 'Unable to update event state';
 217             } else {
 218                 $self->update_state( 'invalid' ) || die 'Unable to update event state';
 219             }
 220         } else {
 221             $self->update_state( 'error' ) || die 'Unable to update event state';
 222         }
 223     } else {
 224         $self->{valid} = undef
 225     }
 226
 227     return $self;
 228 }
 229
 230 sub revalidate_test {
 231     my $self = shift;
 232
 233     if ($self->build_environment->environment->{complete}) {
 234         try {
 235             $self->valid(
 236                 OpenILS::Application::Trigger::ModRunner::Validator->new(
 237                     $self->event->event_def->validator,
 238                     $self->environment
 239                 )->run->final_result
 240             );
 241         } otherwise {
 242             $log->error("Event revalidation failed with ". shift());
 243         };
 244
 245         return 1 if defined $self->valid and $self->valid;
 246         return 0;
 247     }
 248
 249     $logger->error(
 250         "revalidate: could not build environment for event " .
 251         $self->event->id
 252     );
 253     return 0;
 254 }
 255
 256 sub cleanedup {
 257     my $self = shift;
 258     return undef unless (ref $self);
 259
 260     my $c = shift;
 261     $self->{cleanedup} = $c if (defined $c);
 262     return $self->{cleanedup};
 263 }
 264
 265 sub user_data {
 266     my $self = shift;
 267     return undef unless (ref $self);
 268
 269     my $r = shift;
 270     $self->{user_data} = $r if (defined $r);
 271     return $self->{user_data};
 272 }
 273
 274 sub reacted {
 275     my $self = shift;
 276     return undef unless (ref $self);
 277
 278     my $r = shift;
 279     $self->{reacted} = $r if (defined $r);
 280     return $self->{reacted};
 281 }
 282
 283 sub valid {
 284     my $self = shift;
 285     return undef unless (ref $self);
 286
 287     my $v = shift;
 288     $self->{valid} = $v if (defined $v);
 289     return $self->{valid};
 290 }
 291
 292 sub event {
 293     my $self = shift;
 294     return undef unless (ref $self);
 295
 296     my $e = shift;
 297     $self->{event} = $e if (defined $e);
 298     return $self->{event};
 299 }
 300
 301 sub id {
 302     my $self = shift;
 303     return undef unless (ref $self);
 304
 305     my $i = shift;
 306     $self->{id} = $i if (defined $i);
 307     return $self->{id};
 308 }
 309
 310 sub environment {
 311     my $self = shift;
 312     return undef unless (ref $self);
 313
 314     my $e = shift;
 315     $self->{environment} = $e if (defined $e);
 316     return $self->{environment};
 317 }
 318
 319 sub editor {
 320     my $self = shift;
 321     return undef unless (ref $self);
 322
 323     my $e = shift;
 324     $self->{editor} = $e if (defined $e);
 325     return $self->{editor};
 326 }
 327
 328 sub unfind {
 329     my $self = shift;
 330     return undef unless (ref $self);
 331
 332     die 'Cannot unfind a reacted event' if (defined $self->reacted);
 333
 334     $self->update_state( 'pending' ) || die 'Unable to update event state';
 335     $self->{id} = undef;
 336     $self->{event} = undef;
 337     $self->{environment} = undef;
 338     return $self;
 339 }
 340
 341 sub target {
 342     my $self = shift;
 343     return undef unless (ref $self);
 344
 345     my $t = shift;
 346     $self->{target} = $t if (defined $t);
 347     return $self->{target};
 348 }
 349
 350 sub standalone {
 351     my $self = shift;
 352     return undef unless (ref $self);
 353
 354     my $t = shift;
 355     $self->{standalone} = $t if (defined $t);
 356     return $self->{standalone};
 357 }
 358
 359 sub update_state {
 360     my $self = shift;
 361     return undef unless ($self && ref $self);
 362
 363     my $state = shift;
 364     return undef unless ($state);
 365
 366     my $fields = shift;
 367
 368     if ($self->standalone) {
 369         $self->editor->xact_begin || return undef;
 370     }
 371
 372     my $e = $self->editor->retrieve_action_trigger_event( $self->id );
 373     if (!$e) {
 374         $log->error( "Could not retrieve object ".$self->id." for update" ) if (!$e);
 375         return undef;
 376     }
 377
 378     if ($fields && ref($fields)) {
 379         $e->$_($$fields{$_}) for (keys %$fields);
 380     }
 381
 382     $log->info( "Retrieved object ".$self->id." for update" );
 383     $e->start_time( 'now' ) unless $e->start_time;
 384     $e->update_time( 'now' );
 385     $e->update_process( $$ );
 386     $e->state( $state );
 387
 388     $e->clear_start_time() if ($e->state eq 'pending');
 389     $e->complete_time( 'now' ) if ($e->state eq 'complete');
 390
 391     my $ok = $self->editor->update_action_trigger_event( $e );
 392     if (!$ok) {
 393         $self->editor->xact_rollback if ($self->standalone);
 394         $log->error( "Update of event ".$self->id." failed" );
 395         return undef;
 396     } else {
 397         $e = $self->editor->data;
 398         $e = $self->editor->retrieve_action_trigger_event( $e ) if (!ref($e));
 399         if (!$e) {
 400             $log->error( "Update of event ".$self->id." did not return an object" );
 401             return undef;
 402         }
 403         $log->info( "Update of event ".$e->id." suceeded" );
 404         $ok = $self->editor->xact_commit if ($self->standalone);
 405     }
 406
 407     if ($ok) {
 408         $self->event->start_time( $e->start_time );
 409         $self->event->update_time( $e->update_time );
 410         $self->event->update_process( $e->update_process );
 411         $self->event->state( $e->state );
 412     }
 413
 414     return $ok || undef;
 415 }
 416
 417 my $current_environment;
 418
 419 sub build_environment {
 420     my $self = shift;
 421     return $self if ($self->environment->{complete});
 422
 423     $self->update_state( 'collecting') || die 'Unable to update event state';
 424
 425     try {
 426
 427         my $compartment = new Safe;
 428         $compartment->permit(':default','require','dofile','caller');
 429         $compartment->share('$current_environment');
 430
 431         $self->environment->{EventProcessor} = $self;
 432         $self->environment->{target} = $self->target;
 433         $self->environment->{event} = $self->event;
 434         $self->environment->{template} = $self->event->event_def->template;
 435         $self->environment->{user_data} = $self->user_data;
 436
 437         $current_environment = $self->environment;
 438
 439         $self->environment->{params}{ $_->param } = $compartment->reval($_->value) for ( @{$self->event->event_def->params} );
 440
 441         for my $e ( @{$self->event->event_def->env} ) {
 442             my (@label, @path);
 443             @path = split(/\./, $e->path) if ($e->path);
 444             @label = split(/\./, $e->label) if ($e->label);
 445
 446             $self->_object_by_path( $self->target, $e->collector, \@label, \@path );
 447         }
 448
 449         if ($self->event->event_def->group_field) {
 450             my @group_path = split(/\./, $self->event->event_def->group_field);
 451             pop(@group_path); # the last part is a field, should not get fleshed
 452             my $group_object = $self->_object_by_path( $self->target, undef, [], \@group_path ) if (@group_path);
 453         }
 454
 455         $self->environment->{complete} = 1;
 456     } otherwise {
 457         $log->error( shift() );
 458         $self->update_state( 'error' ) || die 'Unable to update event state';
 459     };
 460
 461     if ($self->environment->{complete}) {
 462         $self->update_state( 'collected' ) || die 'Unable to update event state';
 463     } else {
 464         $self->update_state( 'error' ) || die 'Unable to update event state';
 465     }
 466
 467     return $self;
 468 }
 469
 470 sub _fm_class_by_hint {
 471     my $self = shift;
 472     my $hint = shift;
 473
 474     my ($class) = grep {
 475         Fieldmapper->publish_fieldmapper->{$_}->{hint} eq $hint
 476     } keys %{ Fieldmapper->publish_fieldmapper };
 477
 478     return $class;
 479 }
 480
 481 my %_object_by_path_cache = ();
 482 sub ClearObjectCache {
 483     for my $did ( keys %_object_by_path_cache ) {
 484         my $phash = $_object_by_path_cache{$did};
 485         for my $path ( keys %$phash ) {
 486             my $shash = $$phash{$path};
 487             for my $step ( keys %$shash ) {
 488                 my $fhash = $$shash{$step};
 489                 for my $ffield ( keys %$fhash ) {
 490                     my $lhash = $$fhash{$ffield};
 491                     for my $lfield ( keys %$lhash ) {
 492                         delete $$lhash{$lfield};
 493                     }
 494                     delete $$fhash{$ffield};
 495                 }
 496                 delete $$shash{$step};
 497             }
 498             delete $$phash{$path};
 499         }
 500         delete $_object_by_path_cache{$did};
 501     }
 502 }
 503
 504 sub _object_by_path {
 505     my $self = shift;
 506     my $context = shift;
 507     my $collector = shift;
 508     my $label = shift;
 509     my $path = shift;
 510     my $ed = shift;
 511     my $red = shift;
 512
 513     my $outer = 0;
 514     if (!$ed) {
 515         $ed = new_editor(xact=>1);
 516         $outer = 1;
 517     }
 518
 519     my $step = shift(@$path);
 520
 521     my $fhint = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{class};
 522     my $fclass = $self->_fm_class_by_hint( $fhint );
 523
 524     OpenSRF::EX::ERROR->throw(
 525         "$step is not a field on ".$context->class_name."  Please repair the environment.")
 526         unless $fhint;
 527
 528     my $ffield = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{key};
 529     my $rtype = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{reltype};
 530
 531     my $meth = 'retrieve_';
 532     my $multi = 0;
 533     my $lfield = $step;
 534     if ($rtype ne 'has_a') {
 535         $meth = 'search_';
 536         $multi = 1;
 537         $lfield = $context->Identity;
 538     }
 539
 540     $meth .= $fclass;
 541     $meth =~ s/Fieldmapper:://;
 542     $meth =~ s/::/_/g;
 543
 544     my $obj = $context->$step();
 545
 546     $logger->debug(
 547         sprintf "_object_by_path(): meth=%s, obj=%s, multi=%s, step=%s, lfield=%s",
 548         map {defined($_)? $_ : ''} ($meth,  $obj,   $multi,   $step,   $lfield)
 549     );
 550
 551     if (!ref $obj) {
 552
 553         my $lval = $context->$lfield();
 554
 555         if(defined $lval) {
 556
 557             my $def_id = $self->event->event_def->id;
 558             my $str_path = join('.', @$path);
 559
 560             $obj = $_object_by_path_cache{$def_id}{$str_path}{$step}{$ffield}{$lval} ||
 561                 (
 562                     (grep /cstore/, @{
 563                         Fieldmapper->publish_fieldmapper->{$fclass}{controller}
 564                     }) ? $ed : ($red ||= new_rstore_editor(xact=>1))
 565                 )->$meth( ($multi) ? { $ffield => $lval } : $lval);
 566
 567             $_object_by_path_cache{$def_id}{$str_path}{$step}{$ffield}{$lval} ||= $obj;
 568         }
 569     }
 570
 571     if (@$path) {
 572
 573         my $obj_list = [];
 574         if (!$multi) {
 575             $obj_list = [$obj] if ($obj);
 576         } else {
 577             $obj_list = $obj;
 578         }
 579
 580         for (@$obj_list) {
 581             my @path_clone = @$path;
 582             $self->_object_by_path( $_, $collector, $label, \@path_clone, $ed, $red );
 583         }
 584
 585         $obj = $$obj_list[0] if (!$multi || $rtype eq 'might_have');
 586         $context->$step( $obj ) if ($obj && (!$label || !@$label));
 587
 588     } else {
 589
 590         if ($collector) {
 591             my $obj_list = [$obj] if ($obj && !$multi);
 592             $obj_list = $obj if ($multi);
 593
 594             my @new_obj_list;
 595             for my $o ( @$obj_list ) {
 596                 push @new_obj_list,
 597                     OpenILS::Application::Trigger::ModRunner::Collector
 598                         ->new( $collector, $o )
 599                         ->run
 600                         ->final_result
 601             }
 602
 603             if (!$multi) {
 604                 $obj = $new_obj_list[0];
 605             } else {
 606                 $obj = \@new_obj_list;
 607             }
 608         }
 609
 610         if ($label && @$label) {
 611             my $node = $self->environment;
 612             my $i = 0; my $max = scalar(@$label);
 613             for (; $i < $max; $i++) {
 614                 my $part = $$label[$i];
 615                 $$node{$part} ||= {};
 616                 $node = $$node{$part};
 617             }
 618             $$node{$$label[-1]} = $obj;
 619         } else {
 620             $obj = $$obj[0] if $rtype eq 'might_have';
 621             $context->$step( $obj ) if ($obj);
 622         }
 623     }
 624
 625     if ($outer) {
 626         $ed->rollback;
 627         $red->rollback if $red;
 628     }
 629     return $obj;
 630 }
 631
 632 1;