diff Lib/Engine/Action.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/Engine/Action.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,65 @@
+use strict;
+
+package Engine::Action;
+use Engine::CGI;
+use Common;
+use URI;
+use base qw(IMPL::Object IMPL::Object::Disposable IMPL::Object::Autofill IMPL::Object::EventSource);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+our %Fallout;
+
+BEGIN {
+    public _direct property Package => prop_all;
+    public _direct property Method => prop_all;
+    public _direct property Output => prop_all;
+    public _direct property RequestURI => prop_all;
+    public _direct property Result => prop_all;
+    __PACKAGE__->CreateEvent('OnPreInvoke');
+    __PACKAGE__->CreateEvent('OnPastInvoke');
+}
+
+sub Invoke {
+    my ($this,$query) = @_;
+
+    eval {
+        die new Exception('A package isn\'t specified for the action',$this->RequestURI->as_string) if not $this->{$Package};
+        
+        no strict 'refs';        
+        eval "require ".$this->{$Package}.";" or die $@;
+        
+        $this->OnPreInvoke();
+        
+        $this->{$Package}->can($this->{$Method}) or
+            die new Exception("The method doesn't exists", $this->{$Method}, $this->{$Package})
+            if not ref $this->{$Method} eq 'CODE';
+        
+        my $instance = $this->{$Package}->can('revive') ? $this->{$Package}->revive : $this->{$Package};
+        my $method = $this->{$Method};
+    
+        $this->{$Result} = $instance->$method($query,$this);
+        $this->OnPastInvoke();
+    };
+    
+    if($@) {
+        my $err = $@;
+        my $module = ref $this->{$Output} || $this->{$Output};
+        if(my $uri = $module ? ($Fallout{$module}->{ref $err} || $Fallout{$module}->{Default}) : undef) {
+            $this->{$RequestURI} = URI->new($uri,'http');
+            $this->{$Result} = $Common::Debug ? $err : undef;
+        } else {
+            die $err;
+        }
+    }
+}
+
+sub Dispose {
+    my ($this) = @_;
+    
+    undef %$this;
+    
+    $this->SUPER::Dispose;
+}
+
+1;
\ No newline at end of file