view Lib/IMPL/Web/Application/Action.pm @ 258:91bae9f41a9c

Added class for referencing paths in configuration files
author sergey
date Tue, 18 Dec 2012 19:18:31 +0400
parents 32aceba4ee6d
children 89179bb8c388
line wrap: on
line source

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

use Carp qw(carp);

use IMPL::Const qw(:prop);
use IMPL::Web::CGIWrapper();

use IMPL::declare {
    base => [
        'IMPL::Object' => undef,
        'IMPL::Object::Autofill' => '@_'
    ],
    props => [
        application => PROP_RO,
        query => PROP_RO,
        context => PROP_RW
    ]
};

sub CTOR {
    my ($this) = @_;
    
    $this->context({});
}

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

sub param {
    my ($this,$name,$rx) = @_;
    
    my $value;
    
    if (
        $this->requestMethod eq 'GET'
        or
        $this->query->content_type eq 'multipart/form-data'
        or
        $this->query->content_type eq 'application/x-www-form-urlencoded'
    ) {
        $value = scalar( $this->query->param($name) );
    } else {
        $value = scalar( $this->query->url_param($name) );
    }
    
    $this->_launder($value, $rx );
}

sub rawData {
    my ($this) = @_;
    
    local $IMPL::Web::CGIWrapper::NO_DECODE = 1;
    if ($this->requestMethod eq 'POST') {
        return $this->query->param('POSTDATA');
    } elsif($this->requestMethod eq 'PUT') {
        return $this->query->param('PUTDATA');
    }
}

sub requestMethod {
    my ($this) = @_;
    return $this->query->request_method;
}

sub contentType {
    return shift->query->content_type();
}

sub pathInfo {
    my ($this) = @_;
    return $this->query->path_info;
}

sub baseUrl {
    my ($this) = @_;
    
    return $this->query->url(-base => 1);
}

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

1;

__END__

=pod

=head1 NAME

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

=head1 DESCRIPTION

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

=head1 MEMBERS

=head2 C<CTOR(%args)>

Инициализирует новый экземпляр. Именованными параметрами передаются значения
свойств.

=head2 C< [get]application>

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

=item C< [get] query >

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

=back


=cut