view Lib/Engine/Action.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children 76515373dac0
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;