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