view Lib/IMPL/Web/QueryHandler/PageFormat.pm @ 194:4d0e1962161c

Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
children
line wrap: on
line source

package IMPL::Web::QueryHandler::PageFormat;
use parent qw(IMPL::Web::QueryHandler IMPL::Object::Autofill);
use strict;

__PACKAGE__->PassThroughArgs;

use JSON;
use IMPL::Class::Property;
use IMPL::Web::TT::Document;
use Template::Plugin::URL;
use IMPL::Security::Context();
use File::Spec();
use HTML::TreeBuilder();
use URI();
use Error qw(:try);
use Encode();

$Template::Plugin::URL::JOINT = '&';

BEGIN {
    public property templatesCharset => prop_all;
    public property templatesBase => prop_all;
    public property includes => prop_all | prop_list;
    public property pathinfoPrefix => prop_all;
    public property cache => prop_all;
    public property preprocess => prop_all;
    public property formatOutput => prop_all;
    public property template => prop_all;
}

sub CTOR {
    my ($this) = @_;
    
    $this->templatesCharset('utf-8') unless $this->templatesCharset;
    $this->cache(File::Spec->rel2abs($this->cache)) if $this->cache;
    $this->templatesBase(File::Spec->rel2abs($this->templatesBase)) if $this->templatesBase;
}

sub Process {
    my ($this,$action,$nextHandler) = @_;
    
    my $doc = new IMPL::Web::TT::Document(cache => $this->cache, preprocess => $this->preprocess);
    
    try {

        $this->templatesBase($ENV{DOCUMENT_ROOT}) unless $this->templatesBase;
        
        my ($requestUri) = split( /\?/, $ENV{REQUEST_URI} );
        
        my $pathInfo;
        my @root = ('');
        my @base;
        
        if ( $requestUri eq $ENV{SCRIPT_NAME}.$ENV{PATH_INFO} ) {
            # CGI with path info, for example
            # /base/cgi-bin/myscript.cgi/path/info
            # PATH_INFO will be /path/info
            $pathInfo = $ENV{PATH_INFO};
        } else {
            # usual url, for exmaple
            # /base/script.cgi will have PATH_INFO /base/script.cgi
            # /base/ will have PATH_INFO /base/index.cgi (if index.cgi is a DirectoryIndex)
            $pathInfo = $ENV{PATH_INFO};
            
            if (my $rx = $this->pathinfoPrefix) {
                $requestUri =~ s/^($rx)//;
                $pathInfo =~ s/^($rx)//;
                push @root, grep $_, split /\//, $1 if $1;
            }
        }
        
        @base = grep $_, split /\//, ($pathInfo ? substr $requestUri,0, -length($pathInfo) : $requestUri);
        
        local $ENV{PATH_INFO} = $pathInfo;
        
        my @path = grep $_, split /\//, ($ENV{PATH_INFO} || '') or die new IMPL::Exception("PATH_INFO is empty and no defaultTarget specified" );
        
        my @pathContainer = @path;
        pop @pathContainer;
        
        $doc->LoadFile (
            ($this->template || File::Spec->catfile($this->templatesBase,@path)),
            $this->templatesCharset,
            [$this->templatesBase, $this->includes],
            {
                result => scalar($nextHandler->()),
                action => $action,
                app => $action->application,
        
                absoluteUrl => sub { new URI(join ('/', @root, $_[0]) ) },
                baseUrl => sub { new URI (join ('/', @root, @base, $_[0]) ) },
                relativeUrl => sub { new URI(join ('/', @root, @base, @pathContainer,$_[0]) ) },
        
                user => IMPL::Security::Context->current->principal,
                session => IMPL::Security::Context->current,
        
                to_json => \&to_json,
                escape_string => sub { $_[0] =~ s/"/"/g; $_[0] },
            }
        );
        
        $action->response->contentType('text/html');
        my $hOut = $action->response->streamBody;
        if ($this->formatOutput == 1) {
            my $tree = new HTML::TreeBuilder();
            try {
                $tree->parse_content($doc->Render());
                print $hOut $tree->as_HTML('<>&',"    ",{});
            } finally {
                $tree->delete;
            };
        } elsif ($this->formatOutput() == 2 ) {
            (my $data = $doc->Render()) =~ s/\s+/ /g;
            print $hOut $data;
        } else {
            print $hOut $doc->Render();
        }
    } finally {
        $doc->Dispose;
    };
}

sub URI::_query::new_params {
    my ($this,$params) = @_;
    
    my $clone = $this->clone;
    if (ref $params eq 'HASH' ) {
        my %newParams = ($clone->query_form , %$params);
        $clone->query_form(map { $_, ( Encode::is_utf8( $newParams{$_} ) ? Encode::encode('utf-8', $newParams{$_}) : $newParams{$_} ) } sort keys %newParams );
    }
    return $clone;
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::QueryHandler::PageFormat> - Выдача результатов в виде HTML страницы, построенной из шаблона.

=head1 SYNOPSIS

В файле конфигурации приложения

=begin code xml

<handlersQuery type="IMPL::Object::List">
    <item type="IMPL::Web::QueryHandler::PageFormat">
        <charsetTemplates>utf-8</charsetTemplates>
    </item>
</handlersQuery>

=end code xml

Программно

=begin code

my $app = new IMPL::Web::Application();
$app->handlersQuery->Add(
    new IMPL::Web::QueryHandler::PageFormat( charsetTemplates=> 'utf-8' );
);

=end

=head1 DESCRIPTION

Обработчик запроса для веб приложения. Загружает шаблон, путь к котрому берется
из C<ENV{PATH_INFO}> относительно пути из свойства C<templatesBase>.

Наследуется от C<IMPL::Web::QueryHandler> для реализации функционала
обработчика запроса и переопределяет метод C<Process>.

C<Serializable>

=head1 MEMBERS

=over

=item C<CTOR(%props)>

Создает новый экземпляр и заполняет свойства.

=item C<[get,set] templatesCharset>

Кодировка шаблонов. По умолчанию utf-8.

=item C<[get,set] templatesBase>

Каталог относительно которого ищется шаблон.

=item C<[override] Process($action,$nextHandler)>

Метод, переопределяющий C<IMPL::Web::QueryHandler->Process> и которому передается управление
для выполнения действий.

=back

=cut