Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/ModRunner.pm

   1 package OpenILS::Application::Trigger::ModLoader;
   2 use strict; use warnings;
   3 use UNIVERSAL::require;
   4
   5 sub prefix { return 'OpenILS::Application::Trigger' }
   6
   7 sub new {
   8     my $class = shift;
   9     $class = ref($class) || $class;
  10
  11     my $mod = shift;
  12     return undef unless ($mod);
  13
  14     my $self = bless {
  15         module => ref $mod ? $mod->module() : $mod,
  16         handler => 'handler'
  17     } => $class;
  18
  19     return $self->load;
  20 }
  21
  22 sub loaded {
  23     my $self = shift;
  24     return undef unless (ref $self);
  25
  26     my $l = shift;
  27     $self->{loaded} = $l if (defined $l);
  28     return $self->{loaded};
  29 }
  30
  31 sub handler {
  32     my $self = shift;
  33     return undef unless (ref $self);
  34
  35     my $h = shift;
  36     $self->{handler} = $h if $h;
  37     return $self->{handler};
  38 }
  39
  40 sub module {
  41     my $self = shift;
  42     return undef unless (ref $self);
  43
  44     my $m = shift;
  45     $self->{module} = $m if $m;
  46     return $self->{module};
  47 }
  48
  49 sub load {
  50     my $self = shift;
  51     return undef unless (ref $self);
  52
  53     my $m = shift || $self->module;
  54     my $h = shift || $self->handler;
  55     return 1 unless $m;
  56
  57     my $loaded = $m->use;
  58
  59     if (!$loaded) {
  60         my $builtin_m = $self->prefix . "::$m";
  61         $loaded = $builtin_m->use;
  62
  63         if (!$loaded) {
  64             if ($m =~ /::/o) {
  65                 ($h = $m) =~ s/^.+::([^:]+)$/$1/o;
  66                 $m =~ s/^(.+)::[^:]+$/$1/o;
  67
  68                 $loaded = $m->use;
  69
  70                 if (!$loaded) {
  71                     $h =  $self->handler;
  72                     $builtin_m = $self->prefix . "::$m";
  73                     $loaded = $m->use;
  74
  75                     $m = $builtin_m if ($loaded);
  76                 }
  77             } else {
  78                 $loaded = $m->use;
  79
  80                 # The following is an escape hatch for builtin dummy handlers
  81                 if (!$loaded) {
  82                     $loaded = $self->prefix->use;
  83                     if ($loaded && $self->prefix->can( $self->module ) ) {
  84                         $m = $self->prefix;
  85                         $h = $self->module;
  86                     }
  87                 }
  88             }
  89         } else {
  90             $m = $builtin_m;
  91         }
  92     }
  93
  94     if ($loaded) {
  95         $self->module( $m );
  96         $self->handler( $h );
  97     }
  98
  99     $self->loaded($loaded);
 100     return $self;
 101 }
 102
 103 package OpenILS::Application::Trigger::ModRunner;
 104 use base 'OpenILS::Application::Trigger::ModLoader';
 105
 106 sub new {
 107     my $class = shift;
 108     $class = ref($class) || $class;
 109
 110     my $m = shift;
 111     my $e = shift || {};
 112
 113     my $self = $class->SUPER::new( $m );
 114     return undef unless ($self && $self->loaded);
 115
 116     $self->environment( $e );
 117     return $self;
 118 }
 119
 120 sub pass {
 121     my $old = shift;
 122     return undef unless (ref $old);
 123
 124     my $class = ref($old);
 125     my $m = shift;
 126
 127     my $self = $class->SUPER::new( $m );
 128     return undef unless ($self && $self->loaded);
 129
 130     $self->environment( $old->environment );
 131     return $self;
 132 }
 133
 134 sub environment {
 135     my $self = shift;
 136     return undef unless (ref $self);
 137
 138     my $e = shift;
 139     $self->{environment} = $e if (defined $e);
 140     return $self->{environment};
 141 }
 142
 143 sub final_result {
 144     my $self = shift;
 145     return undef unless (ref $self);
 146
 147     my $r = shift;
 148     $self->{final_result} = $r if (defined $r);
 149     return $self->{final_result};
 150 }
 151
 152 sub run {
 153     my $self = shift;
 154     return undef unless (ref $self && $self->loaded);
 155
 156     $self->environment( shift );
 157
 158     my $m = $self->module;
 159     my $h = $self->handler;
 160     my $e = $self->environment;
 161     $self->final_result( $m->$h( $e ) );
 162
 163     return $self;
 164 };
 165
 166 package OpenILS::Application::Trigger::ModRunner::Collector;
 167 use base 'OpenILS::Application::Trigger::ModRunner';
 168 sub prefix { return 'OpenILS::Application::Trigger::Collector' }
 169
 170 package OpenILS::Application::Trigger::ModRunner::Validator;
 171 use base 'OpenILS::Application::Trigger::ModRunner';
 172 sub prefix { return 'OpenILS::Application::Trigger::Validator' }
 173
 174 package OpenILS::Application::Trigger::ModRunner::Reactor;
 175 use base 'OpenILS::Application::Trigger::ModRunner';
 176 sub prefix { return 'OpenILS::Application::Trigger::Reactor' }
 177
 178 package OpenILS::Application::Trigger::ModRunner::Cleanup;
 179 use base 'OpenILS::Application::Trigger::ModRunner';
 180 sub prefix { return 'OpenILS::Application::Trigger::Cleanup' }
 181
 182 package OpenILS::Application::Trigger::ModStackRunner;
 183 use base 'OpenILS::Application::Trigger::ModRunner';
 184
 185 sub new {
 186     my $class = shift;
 187     $class = ref($class) || $class;
 188
 189     my $m = shift;
 190     $m = [$m] unless (ref($m) =~ /ARRAY/o);
 191
 192     my $e = shift || {};
 193
 194     my $self = bless {
 195         runners => []
 196     } => $class;
 197
 198     for my $mod ( @$m ) {
 199         my $r = $self->SUPER::new( $m );
 200         return undef unless ($r && $r->loaded);
 201         push @{$self->{runners}}, $r;
 202     }
 203
 204     $self->loaded(1);
 205
 206     return $self;
 207 }
 208
 209 sub pass {
 210     my $old = shift;
 211     return undef unless (ref $old);
 212
 213     my $class = ref($old);
 214     my $m = shift;
 215
 216     my $self = $class->new( $m );
 217     return undef unless ($self && $self->loaded);
 218
 219     $self->environment( $old->environment );
 220     return $self;
 221 }
 222
 223 sub run {
 224     my $self = shift;
 225     return undef unless (ref $self && $self->loaded);
 226
 227     $self->environment( shift );
 228     my $e = $self->environment;
 229
 230     for my $r (@{$self->{runners}}) {
 231         my $m = $r->module;
 232         my $h = $r->handler;
 233         $r->final_result( $m->$h( $e ) );
 234     }
 235
 236     return $self;
 237 };
 238
 239 1;