view Lib/IMPL/Web/Application.pm @ 390:de1f875e8875

added reverse matching lookup to TypeKeyedCollection (find closest descendant)
author cin
date Wed, 12 Feb 2014 18:02:03 +0400
parents ec58c47edb52
children
line wrap: on
line source

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

use CGI;
use Carp qw(carp);
use IMPL::Const qw(:prop);

use IMPL::declare {
	require => {
	    Locator                   => 'IMPL::Web::AutoLocator',
		TAction                   => 'IMPL::Web::Application::Action',
		HttpResponse              => 'IMPL::Web::HttpResponse',
		TFactory                  => '-IMPL::Object::Factory',
		Exception                 => 'IMPL::Exception',
		ArgException              => '-IMPL::InvalidArgumentException',
		InvalidOperationException => '-IMPL::InvalidOperationException',
		Loader                    => 'IMPL::Code::Loader'
	  },
	  base => [
		'IMPL::Config'            => '@_',
		'IMPL::Object::Singleton' => undef
	  ],
	  props => [
	    baseUrl            => PROP_RW,
		actionFactory      => PROP_RW,
		handlers           => PROP_RW | PROP_LIST,
		securityFactory    => PROP_RW,
		output             => PROP_RW,
		location           => PROP_RO,
		_handler           => PROP_RW
	  ]
};

sub CTOR {
	my ($this) = @_;

	die IMPL::InvalidArgumentException->new( "handlers",
		"At least one handler should be supplied" )
	  unless $this->handlers->Count;

    $this->baseUrl('/') unless $this->baseUrl;
    
	$this->actionFactory(TAction) unless $this->actionFactory;
	$this->location(Locator->new(base => $this->baseUrl));
}

sub CreateSecurity {
	my $factory = shift->securityFactory;
	return $factory ? $factory->new() : undef;
}

sub ProcessRequest {
    my ($this,$q) = @_;
    
    die ArgException->new(q => 'A query is required')
        unless $q;
    
    my $handler = $this->_handler;
    unless ($handler) {
        $handler = _ChainHandler( $_, $handler ) foreach $this->handlers;
        $this->_handler($handler);
    }
    
    my $action = $this->actionFactory->new(
        query       => $q,
        application => $this,
    );
    
    eval {
        my $result = $handler->($action);

        die InvalidOperationException->new("Invalid handlers result. A reference to IMPL::Web::HttpResponse is expexted.")
            unless eval { $result->isa(HttpResponse) };

        $result->PrintResponse( $this->output );
    };
    
    $action->Dispose();
    
    if ($@) {
        my $e = $@;

        HttpResponse->InternalError(
            type    => 'text/plain',
            charset => 'utf-8',
            body    => $e
        )->PrintResponse( $this->output );

    }
}

sub _ChainHandler {
	my ( $handler, $next ) = @_;

	if ( ref $handler eq 'CODE' ) {
		return sub {
			my ($action) = @_;
			return $handler->( $action, $next );
		};
	}
	elsif ( eval { $handler->can('Invoke') } ) {
		return sub {
			my ($action) = @_;
			return $handler->Invoke( $action, $next );
		};
	}
	elsif ( eval { $handler->isa(TFactory) } ) {
		return sub {
			my ($action) = @_;
			my $inst = $handler->new();
			return $inst->Invoke( $action, $next );
		  }
	}
	elsif ( $handler
		and not ref $handler
		and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/ )
	{
		my $class = $2;
		if ( not $1 ) {
			Loader->safe->Require($class);
			die IMPL::InvalidArgumentException->(
				"An invalid handler supplied", $handler
			) unless $class->can('Invoke');
		}

		return sub {
			my ($action) = @_;
			my $inst = $class->new();
			return $inst->Invoke( $action, $next );
		};
	}
	else {
		die new IMPL::InvalidArgumentException( "An invalid handler supplied",
			$handler );
	}
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application> Базовай класс для веб-приложения

=cut