view Lib/Engine/Action.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
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;