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