changeset 196:a705e848dcc7

added IMPL::Config::Reference
author cin
date Mon, 16 Apr 2012 17:42:54 +0400
parents 7a920771fd8e
children 6b1dda998839
files Lib/IMPL/Config/Class.pm Lib/IMPL/Config/Container.pm Lib/IMPL/Config/Reference.pm Lib/IMPL/Serialization.pm Lib/IMPL/Web/Application/RestResource.pm Lib/IMPL/Web/Handler/SecureCookie.pm Lib/IMPL/Web/View/TTLoader.pm
diffstat 7 files changed, 261 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Config/Class.pm	Wed Apr 11 17:50:33 2012 +0400
+++ b/Lib/IMPL/Config/Class.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -5,8 +5,11 @@
 use parent qw(IMPL::Config);
 use IMPL::Exception;
 use IMPL::Class::Property;
+use Carp qw(carp);
 
 BEGIN {
+	carp "the module is deprecated";
+	
     public property Type => prop_all;
     public property Parameters => prop_all;
     public property IsSingleton => prop_all;
--- a/Lib/IMPL/Config/Container.pm	Wed Apr 11 17:50:33 2012 +0400
+++ b/Lib/IMPL/Config/Container.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -4,8 +4,11 @@
 
 use parent qw(IMPL::Config);
 use IMPL::Class::Property;
+use Carp qw(carp);
 
 BEGIN {
+	carp "the module is deprecated";
+	
     public property Chidren => prop_all;
 }
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Config/Reference.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -0,0 +1,97 @@
+package IMPL::Config::Reference;
+use strict;
+
+use IMPL::Exception;
+
+__PACKAGE__->PassThroughArgs;
+
+sub restore {
+	my ($self,$data,$surrogate) = @_;
+	
+	my @path;
+	
+	my ($tagTarget,$target) = splice @$data, 0, 2;
+	
+	die new IMPL::Exception('A traget tag must be the first tag in the reference specification') unless $tagTarget eq 'target';
+	
+	while(my ($method,$args) = splice @$data, 0, 2 ) {
+		$target = $self->_Invoke({ method => $method, args => $args});
+	}
+	return $target;
+}
+
+sub _InvokeMember {
+    my ($self,$object,$member) = @_;
+    
+    my $method = $member->{method};
+    
+    local $@;
+    return eval {
+        ref $object eq 'HASH' ?
+            $object->{$method}
+            :
+            $object->$method(
+                exists $member->{args} ?
+                    _as_list($member->{args})
+                    :
+                    ()
+            )
+    };
+}
+
+sub _as_list {
+    ref $_[0] ?
+        (ref $_[0] eq 'HASH' ?
+            %{$_[0]}
+            :
+            (ref $_[0] eq 'ARRAY'?
+                @{$_[0]}
+                :
+                $_[0]
+            )
+        )
+        :
+        ($_[0]);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Config::Reference> - ссылка на внешний объект, вычисляемый на этапе десериализации данных.
+
+=head1 SYNOPSIS
+
+=begin code xml
+
+<Application>
+	<processingStack type="IMPL::Config::Reference">
+	   <target>IMPL::Config</target>
+	   <LoadXMLFile>stdprocessing.xml</LoadXMLFile>
+	</processingStack>
+</Application>
+
+=end code xml
+
+=head1 DESCRIPTION
+
+Позволяет на указвать ссылки на вычисляемые объекты, например, загружаемые из файлов. Ссылки такого рода
+будут вычислены на этапе десериализации еще до того, как будет создан объект верхнего уровня, поэтому
+следует избегать таких ссылок на сам (его свойства и методы) десериализуемый объект.  
+
+=head1 MEMBERS
+
+=head2 C<restore($class,$data,$surrogate)>
+
+Использует данные переданные в параметре дата C<$data> для вычисления свойства. Данный метод - стандартный
+метод для десериализации объекта, а параметр C<$data> содержит пары значений C<(имя_узла,значение_узла)>,
+первая пара обязательно является узлом C<target>, а его значение - целевой объект, который будет
+использован для вычисления конечного значения.
+
+=back
+
+=cut
\ No newline at end of file
--- a/Lib/IMPL/Serialization.pm	Wed Apr 11 17:50:33 2012 +0400
+++ b/Lib/IMPL/Serialization.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -1,12 +1,6 @@
 package IMPL::Serialization;
 use strict;
 
-# 20060222
-# пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
-# (пїЅ) Sourcer, cin.sourcer@gmail.com
-# revision 3 (20090517)
-
-
 package IMPL::Serialization::Context;
 use parent qw(IMPL::Object);
 
@@ -16,31 +10,24 @@
 use Scalar::Util qw(refaddr);
 
 BEGIN {
-  private _direct property ObjectWriter => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅ
-  private _direct property Context => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ (пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ)
-  private _direct property NextID => prop_all;# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ
+  private _direct property ObjectWriter => prop_all;
+  private _direct property Context => prop_all;
+  private _direct property NextID => prop_all;
 
-  # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
-  # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ IMPL::Serialization::Context, пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
   public _direct property Serializer => prop_all;
   
-  private _direct property State => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
+  private _direct property State => prop_all;
 }
 
-# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ.пїЅ. пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ
 sub STATE_CLOSED () { 0 }
-# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ.пїЅ. пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅ пїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ
 sub STATE_OPENED () { 1 }
-# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
 sub STATE_COMPLEX () { 2 }
-# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
 sub STATE_DATA () { 3 }
 
 sub CTOR {
   my ($this,%args) = @_;
   
   $this->{$ObjectWriter} = $args{'ObjectWriter'};
-  #$this->{$Context} = {};
   $this->{$NextID} = 1;
   $this->{$Serializer} = ($args{'Serializer'} ? $args{'Serializer'} : \&DefaultSerializer );
   $this->{$State} = STATE_CLOSED;
@@ -54,11 +41,9 @@
   die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA;
   
   if (not ref $Var) {
-    # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ
-    # пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ
     my $prevState = $this->{$State};
     
-    $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR');
+    $this->{$ObjectWriter}->BeginObject(name => $sName);
     $this->{$State} = STATE_OPENED;
     
     $this->{$Serializer}->($this,\$Var);
@@ -148,10 +133,9 @@
 use IMPL::Exception;
 
 BEGIN {
-  # пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ, пїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅ.
   private _direct property Context => prop_all;
 
-  # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
+  # структура информации об объекте
   # {
   #   Type => 'typename',
   #   Name => 'object_name',
@@ -160,10 +144,8 @@
   # }
   private _direct property CurrentObject => prop_all;
 
-  # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ.
   private _direct property ObjectsPath => prop_all;
 
-  # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
   public _direct property Root => prop_get;
 
   # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/RestResource.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -0,0 +1,16 @@
+package IMPL::Web::Application::RestResource;
+use strict;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Application::RestResource> - ресурс Rest вебсервиса.
+
+=head1 DESCRIPTION
+
+=cut
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Handler/SecureCookie.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -0,0 +1,115 @@
+package IMPL::Web::QueryHandler::SecureCookie;
+use strict;
+
+use parent qw(IMPL::Web::QueryHandler);
+use Digest::MD5 qw(md5_hex);
+
+use IMPL::Class::Property;
+use IMPL::Security::Auth qw(:Const);
+use IMPL::Security;
+
+BEGIN {
+    public property salt => prop_all;
+}
+
+sub CTOR {
+    my ($this) = @_;
+    
+    $this->salt('DeadBeef') unless $this->salt;
+}
+
+sub Process {
+    my ($this,$action,$nextHandler) = @_;
+    
+    return undef unless $nextHandler;
+    
+    local $IMPL::Security::authority = $this;
+    
+    my $method = $action->query->cookie('method') || 'simple';
+    
+    if ($method eq 'simple') {
+        
+        my $sid = $action->query->cookie('sid'); 
+        my $cookie = $action->query->cookie('sdata');
+        my $sign = $action->query->cookie('sign'); 
+        
+        if (
+            $sid and
+            $cookie and
+            $sign and
+            $sign eq md5_hex(
+                $this->salt,
+                $sid,
+                $cookie,
+                $this->salt
+            )
+        ) {
+            # TODO: add a DefferedProxy to deffer a request to a data source
+            my $context = $action->application->security->sourceSession->find(
+                { id => $sid }
+            ) or return $nextHandler->();
+            
+            my ($result,$challenge) = $context->auth->ValidateSession($cookie);
+            
+            if ($result == AUTH_SUCCESS) {
+                $context->authority($this);
+                return $context->Impersonate($nextHandler);                
+            } else {
+                return $nextHandler->();
+            }
+        } else {
+            return $nextHandler->();
+        }
+    } else {
+        return $nextHandler->();
+    }
+}
+
+sub WriteResponse {
+    my ($this,$response,$sid,$cookie,$method) = @_;
+
+    my $sign = md5_hex(
+        $this->salt,
+        $sid,
+        $cookie,
+        $this->salt
+    );
+    
+    $response->setCookie(sid => $sid);
+    $response->setCookie(sdata => $cookie);
+    $response->setCookie(sign => $sign);
+    $response->setCookie(method => $method) if $method;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::QueryHandler::SecureCookie>
+
+=head1 DESCRIPTION
+
+C<use parent qw(IMPL::Web::QueryHandler)>
+
+Возобновляет сессию пользователя на основе информации переданной через Cookie.
+
+Использует механизм подписи информации для проверки верности входных данных перед
+началом каких-либо действий.
+
+Данный обработчик возвращает результат выполнения следдующего обработчика.
+
+=head1 MEMBERS
+
+=over
+
+=item C<[get,set] salt>
+
+Скаляр, использующийся для подписи данных.
+
+=back
+
+=cut
--- a/Lib/IMPL/Web/View/TTLoader.pm	Wed Apr 11 17:50:33 2012 +0400
+++ b/Lib/IMPL/Web/View/TTLoader.pm	Mon Apr 16 17:42:54 2012 +0400
@@ -11,6 +11,7 @@
 
 use parent qw(
     IMPL::Object
+    IMPL::Object::Serializable
 );
 
 BEGIN {
@@ -26,6 +27,26 @@
     private property _globals => PROP_ALL;
 }
 
+sub save {
+	my ($this,$context) = @_;
+	
+	$context->AddVar($_, $this->$_()) for qw(options provider context ext layoutBase);
+}
+
+sub restore {
+	my ($class,$data,$surrogate) = @_;
+	
+	my %params = @$data;
+	
+	my $refOpts = delete $params{options};
+	
+	if ($surrogate){
+		$surrogate->callCTOR($refOpts,%params);
+	} else {
+		$surrogate = $class->new($refOpts,%params);
+	}
+}
+
 sub CTOR {
     my ($this,$refOpts,%args) = @_;