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

use Carp qw(carp);

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

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

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

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

sub header {
	my ($this,$header) = @_;
	
	$this->query->https ? $this->query->https($header) : $this->query->http($header);
}

sub isSecure {
	shift->query->https ? 1 : 0;
}

sub isJson {
	return shift->contentType =~ m{^application/json} ? 1 : 0;
}

sub param {
    my ($this,$name,$rx) = @_;
    
    my $value;
    
    if (
        $this->requestMethod eq 'GET'
        or
        $this->contentType eq 'multipart/form-data'
        or
        $this->contentType 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 urlParams {
    shift->query->url_param();
}

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

sub jsonData {
    my ($this) = @_;
    
    if ($this->isJson ) {
        my $data = $this->_jsonData;
        unless($data) {
            $data = JSON->new()->decode($this->rawData('decode encoding'));
            $this->_jsonData($data);
        }
        
        return $data;
    }
    
    return;
}

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