diff lib/IMPL/Web/Application/Action.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Web/Application/Action.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,227 @@
+package IMPL::Web::Application::Action;
+use strict;
+
+use Carp qw(carp);
+use URI;
+use JSON;
+
+use IMPL::lang;
+use IMPL::Const qw(:prop);
+use IMPL::Web::CGIWrapper();
+use IMPL::declare {
+    require => {
+        Disposable => '-IMPL::Object::Disposable',
+        HttpResponse => 'IMPL::Web::HttpResponse'
+    },
+    base => [
+        'IMPL::Object' => undef,
+        'IMPL::Object::Autofill' => '@_',
+        'IMPL::Object::Disposable' => undef
+    ],
+    props => [
+        application => PROP_RW,
+        security => PROP_RW,
+        query => PROP_RO,
+        context => PROP_RW,
+        _jsonData => PROP_RW,
+    ]
+};
+
+sub CTOR {
+    my ($this) = @_;
+    
+    $this->context({});
+    $this->security($this->application->CreateSecurity());
+}
+
+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 Redirect {
+	my ($this,$path) = @_;
+	return HttpResponse->Redirect(
+		location => $this->CreateFullUrl($path)
+	);
+}
+
+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;
+    }
+}
+
+sub Dispose {
+    my ($this) = @_;
+    
+    $this->security->Dispose()
+        if $this->security and $this->security->can('Dispose');
+    
+    $_->Dispose() foreach grep is($_,Disposable), values %{$this->context}; 
+    
+    $this->next::method();
+}
+
+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