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