Foundations of Action/Triger-based telephony,
[working/Evergreen.git] / 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;