view Lib/IMPL/Web/Application/Action.pm @ 295:9b25e1f50144

sync
author cin
date Fri, 01 Mar 2013 03:15:30 +0400
parents 4abda21186cd
children 28eba7e0c592
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 URI;

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 urlParam {
    my ($this,$name,$rx) = @_;
    
    $this->_launder(scalar( $this->query->url_param($name) ), $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 applicationUrl {
    shift->application->baseUrl;
}

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

# creates an url that contains server, schema and path parts
sub CreateFullUrl {
    my ($this,$path) = @_;
    
    return $path ? URI->new_abs($path,$this->applicationFullUrl) : $this->applicationFullUrl;
}

# creates an url that contains only a path part
sub CreateAbsoluteUrl {
    my ($this,$path) = @_;
    
    return $path ? URI->new_abs($path,$this->applicationUrl) : $this->applicationUrl;
}

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