[open-ils-commits] r11943 - trunk/Open-ILS/src/perlmods/OpenILS/Application
svn at svn.open-ils.org
svn at svn.open-ils.org
Fri Jan 23 20:49:29 EST 2009
Author: miker
Date: 2009-01-23 20:49:28 -0500 (Fri, 23 Jan 2009)
New Revision: 11943
Added:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm
Log:
start of the event firing code -- build the environment for validators, reactors and cleanup modules
Added: trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm (rev 0)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm 2009-01-24 01:49:28 UTC (rev 11943)
@@ -0,0 +1,149 @@
+package OpenILS::Application::Trigger;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+use OpenSRF::EX qw/:try/;
+
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/:level/;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Trigger::ModRunner;
+
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub initialize {}
+sub child_init {}
+
+sub build_env {
+ my $event = shift;
+ my $environment = shift || {};
+ my $cstore = new_editor();
+
+ my $def = $cstore->retrieve_action_trigger_event_definition( $event->event_def );
+ my $hook = $cstore->retrieve_action_trigger_hook( $def->hook );
+ my $class = _fm_class_by_hint( $hook->core_type );
+
+ my $meth = "retreive_" . $class;
+ $meth =~ s/Fieldmapper:://;
+ $meth =~ s/::/_/;
+
+ my $target = $cstore->$meth( $event->target );
+ $$environment{target} = $target;
+ $$environment{event} = $event->to_bare_hash;
+
+ my @env_list = $cstore->search_action_trigger_environment( { event_def => $event->event_def } );
+ my @param_list = $cstore->search_action_trigger_params( { event_def => $event->event_def } );
+
+ $$environment{params}{ $_->param } = eval $_->value for ( @param_list );
+
+ for my $e ( @env_list ) {
+ my (@label, @path);
+ @path = split('.', $e->path) if ($e->path);
+ @label = split('.', $e->label) if ($e->label);
+
+ my $collector = $e->collector;
+ _object_by_path( $cstore, $target, $collector, \@label, $environment, @path );
+ }
+
+ return $environment;
+}
+
+sub _fm_class_by_hint {
+ my $hint = shift;
+
+ my ($class) = grep {
+ OpenILS::Utils::Fieldmapper->publish_fieldmapper->{$_}->{hint} eq $hint
+ } keys %{ OpenILS::Utils::Fieldmapper->publish_fieldmapper };
+
+ return $class;
+}
+
+sub _object_by_path {
+ my $cstore = shift;
+ my $context = shift;
+ my $collector = shift;
+ my $label = shift;
+ my $env = shift;
+ my @path = @_;
+
+ my $step = shift(@path);
+
+ my $fhint = OpenILS::Utils::Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{class};
+ my $fclass = _fm_class_by_hint( $fhint );
+
+ my $ffield = OpenILS::Utils::Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{key};
+ my $rtype = OpenILS::Utils::Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{reltype};
+
+ my $meth = 'retrieve_';
+ my $multi = 0;
+ my $lfield = $step;
+ if ($rtype eq 'has_many') {
+ $meth = 'search_';
+ $multi = 1;
+ $lfield = $context->Identity;
+ }
+
+ $meth .= $fclass;
+ $meth =~ s/Fieldmapper:://;
+ $meth =~ s/::/_/;
+
+ my $obj = $cstore->$meth( { $ffield => $context->$lfield() } );
+
+ if (@path) {
+
+ my $obj_list = [];
+ if (!$multi) {
+ $obj_list = [$obj] if ($obj);
+ } else {
+ $obj_list = $obj;
+ }
+
+ _object_by_path( $cstore, $_, $collector, $label, $env, @path ) for (@$obj_list);
+
+ $obj = $$obj_list[0] if (!$multi);
+ $context->$step( $obj ) if ($obj && !$label);
+
+ } else {
+
+ if ($collector) {
+ my $obj_list = [$obj] if ($obj && !$multi);
+ $obj_list = $obj if ($multi);
+
+ my @new_obj_list;
+ for my $o ( @$obj_list ) {
+ push @new_obj_list,
+ OpenILS::Application::Trigger::ModRunner
+ ->new( $collector, $o )
+ ->run
+ ->final_result;
+ }
+
+ if (!$multi) {
+ $obj = $new_obj_list[0];
+ } else {
+ $obj = \@new_obj_list;
+ }
+ }
+
+ if ($label) {
+ my $node = $env;
+ my $i = 0; my $max = scalar(@$label) - 1;
+ for (; $i < $max; $i++) {
+ my $part = $$label[$i];
+ $$node{$part} ||= {};
+ $node = $$node{$part};
+ }
+ $$node{$$label[-1]} = $obj;
+ } else {
+ $context->$step( $obj ) if ($obj);
+ }
+ }
+
+ return $obj;
+}
+
+1;
More information about the open-ils-commits
mailing list