view Lib/Engine/Action.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

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;