view Lib/IMPL/Web/Application/Action.pm @ 213:d6e2ea24af08

sync
author sergey
date Fri, 03 Aug 2012 01:15:15 +0400
parents c8fe3f84feba
children 47f77e6409f7
line wrap: on
line source

package IMPL::Web::Application::Action;
use strict;

use parent qw(IMPL::Object IMPL::Object::Autofill);

__PACKAGE__->PassThroughArgs;

use IMPL::Class::Property;
use Carp qw(carp);

BEGIN {
    public property application => prop_get | owner_set;
    public property query => prop_get | owner_set;
    public property response => prop_get | owner_set;
    public property responseFactory => prop_get | owner_set;
    public property context => prop_get | owner_set;
    private property _entryPoint => prop_all;
}

sub CTOR {
    my ($this) = @_;
    
    $this->responseFactory('IMPL::Web::Application::Response') unless $this->responseFactory; 
    $this->response( $this->responseFactory->new(query => $this->query) );
    $this->context({});
}

sub Invoke {
    my ($this) = @_;
    
    if ($this->_entryPoint) {
        $this->_entryPoint->();
    } else {
        die new IMPL::InvalidOperationException("At least one handler is required");
    }
}

sub ReinitResponse {
    my ($this) = @_;
    
    die new IMPL::InvalidOperationException("Response already sent") if $this->response->isHeaderPrinted;
    
    $this->response->Discard;
    $this->response($this->responseFactory->new(query => $this->query));
}

sub ChainHandler {
    my ($this,$handler) = @_;
    
    carp "deprecated, use Application->handlers instead";
    
    my $delegateNext = $this->_entryPoint();
    
    if (ref $handler eq 'CODE') {
        $this->_entryPoint( sub {
            $handler->($this,$delegateNext);    
        } );
    } elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
        $this->_entryPoint( sub {
            $handler->Invoke($this,$delegateNext);
        } );
    } elsif ($handler and not ref $handler) {
        
        if (my $method = $this->can($handler) ) {
            $this->_entryPoint( sub {
                $method->($this,$delegateNext);            
            } );
        } else {
            {
                no strict 'refs';
                eval "require $handler; 1;" or die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler,"Failed to load module") unless keys %{"${handler}::"};
            }
            
            if (UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
                $this->_entryPoint( sub {
                    $handler->Invoke($this,$delegateNext);
                } );    
            } else {
                die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
            }
        }
    } else {
        die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
    }
    
}

sub cookie {
    my ($this,$name,$rx) = @_;
    
    $this->_launder(scalar( $this->query->cookie($name) ), $rx );
}

sub param {
    my ($this,$name,$rx) = @_;
    
    $this->_launder(scalar( $this->query->param($name) ), $rx );
}

sub _launder {
    my ($this,$value,$rx) = @_;
    
    if ( $value ) {
        if ($rx) {
            if ( my @result = ($value =~ m/$rx/) ) {
                return @result > 1 ? \@result : $result[0];
            } else {
                return undef;
            }
        } else {
            return $value;
        }
    } else {
        return undef;
    }
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса.

=head1 DESCRIPTION

C<[Infrastructure]>
Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту.

=head1 MEMBERS

=head2 PROPERTIES

=over

=item C< [get] application>

Экземпляр приложения создавшего текущий объект

=item C< [get] query >

Экземпляр C<CGI> запроса

=item C< [get] response >

Ответ на C<CGI> заспрос C<IMPL::Web::Application::Response>

=item C< [get] responseFactory >

Фабрика ответов на запрос, используется для создания нового ответа
либо при конструировании текущего объекта C<IMPL::Web::Application::Action>,
либо при вызове метода C<ReinitResponse> у текущего объекта.

По умолчанию имеет значение C<IMPL::Web::Application::Response>

=back

=head2 METHODS

=over

=item C< ReinitResponse() >

Отмена старого ответа C<response> и создание вместо него нового.

Данная операция обычно проводится при обработке ошибок, когда
уже сформированный ответ требуется отменить. Следует заметить,
что эта операция не возможна, если ответ частично или полностью
отправлен клиенту. Тогда возникает исключение C<IMPL::InvalidOperationException>.

=cut