LP#1410369: Create user messages when configured to do so
[Evergreen.git] / 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;