Improvement for telephony: just-in-time event revalidation
[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     $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;