changeset 263:0f59b2de72af

*fixed IMPL::DOM::Schema circular module references *modified IMPL::Object::Singleton, added auto-activation *code cleanups, docs
author sergey
date Wed, 09 Jan 2013 05:17:44 +0400
parents 4ac39b9e2ca4
children c9c2ec29793f
files Lib/IMPL/Class/Meta.pm Lib/IMPL/Config.pm Lib/IMPL/DOM/Schema.pm Lib/IMPL/DOM/Schema/Property.pm Lib/IMPL/DOM/Transform/ObjectToDOM.pm Lib/IMPL/DOM/XMLReader.pm Lib/IMPL/Object/Singleton.pm Lib/IMPL/Web/Handler/SecureCookie.pm Lib/IMPL/Web/View/TTDocument.pm Lib/IMPL/require.pm _test/Resources/TTView/My/Org/Panel.tt _test/Test/Web/TT.pm _test/Test/Web/View.pm _test/Web.t
diffstat 14 files changed, 168 insertions(+), 63 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Class/Meta.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/Class/Meta.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -134,6 +134,7 @@
     
     *{"${class}::$name"} = sub {
         my $self = shift;
+        $self = ref $self || $self;
         
         if ($class ne $self) {
             if (@_ > 0) {
--- a/Lib/IMPL/Config.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/Config.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -2,9 +2,13 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::Object::Accessor IMPL::Object::Serializable IMPL::Object::Autofill);
-
-__PACKAGE__->PassThroughArgs;
+use IMPL::declare {
+    base => [
+        'IMPL::Object::Accessor' => undef,
+        'IMPL::Object::Serializable' => undef,
+        'IMPL::Object::Autofill' => '@_'
+    ]
+};
 
 use File::Spec();
 
--- a/Lib/IMPL/DOM/Schema.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -15,7 +15,7 @@
     SwitchNode => 'IMPL::DOM::Schema::SwitchNode',
     Validator => 'IMPL::DOM::Schema::Validator',
     Builder => 'IMPL::DOM::Navigator::Builder',
-    XMLReader => 'IMPL::DOM::XMLReader',
+    XMLReader => 'IMPL::DOM::XMLReader', # XMLReader references Schema
     InflateFactory => 'IMPL::DOM::Schema::InflateFactory',
     Loader => 'IMPL::Code::Loader'
 };
--- a/Lib/IMPL/DOM/Schema/Property.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/DOM/Schema/Property.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -3,7 +3,6 @@
 use warnings;
 
 use parent qw(IMPL::DOM::Schema::SimpleNode);
-require IMPL::DOM::Schema;
 require IMPL::DOM::Node;
 use IMPL::Class::Property;
 use IMPL::DOM::Property qw(_dom);
--- a/Lib/IMPL/DOM/Transform/ObjectToDOM.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/DOM/Transform/ObjectToDOM.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -49,6 +49,7 @@
     $this->_schema($docSchema);
     
     $this->_navi->NavigateCreate($docName);
+    $this->currentNode->nodeProperty(schemaDocument => $docSchema);
 }
 
 sub TransformPlain {
@@ -166,8 +167,104 @@
 
 =head1 NAME
 
-C<IMPL::DOM::Transform::ObjectToDOM> -преобразование объекта  
+C<IMPL::DOM::Transform::ObjectToDOM> -преобразование объекта в DOM документ.
 
 =head1 SYNOPSIS 
 
+=begin code
+
+use IMPL::require {
+    Schema => 'IMPL::DOM::Schema',
+    Config => 'IMPL::Config'
+}
+
+my $data = {
+    id => '12313-232',
+    name => 'Peter',
+    age => 20
+};
+
+my $schema = Schema->LoadSchema(Config->AppBase('schemas','person.xml'));
+my $transorm = IMPL::DOM::Transform::ObjectToDOM->new('edit', $schema);
+
+my $form = $transform->Transform($data);
+
+my @errors;
+    
+push @errors, $transform->buildErrors;
+push @errors, $schema->Validate($doc);
+
+=end code
+
+=head1 DESCRIPTION
+
+Наследует C<IMPL::Transform>. Определяет базовые преобразования для хешей и
+объектов, поддерживающих метаданные.
+
+Результатом выполнения преобразования является DOM документ. При построении
+документа используется навигатор C<IMPL::DOM::Navigator::Builder> для
+сопоставления схемы и свойств преобразуемого объекта. Элементы полученного
+документа имеют ссылки на соответствующие им элементы схемы.
+
+После того, как документ построен и преобразование будет очищено, не останется
+объектов, которые бы ссылались на документ со схемой, поскольку элементы схемы
+имеют слабые ссылки на саму схему и не могут предотвратить ее удаление.
+Для предотвращения очитски документа схемы, ссылка на него сохраняется в
+атрибуте документа C<schemaDocument>, что обеспечит жизнь схемы на протяжении
+жизни документа.
+
+Преобразование происходит рекурсивно, сначала используется метод
+C<NavigateCreate> для создания элемента соответсвующего свойству объекта,
+затем вызывается метод C<Transform> для преобразования значения свойства, при
+этом C<currentNode> указывает на только что созданный элемент документа.
+
+=head1 MEMBERS
+
+=head2 C<CTOR($docName,$schema)>
+
+Создает преобразование, при этом будет создан документ состоящий только из
+корневого элемента с именем C<$docName> и будет найдена подходящий для него
+элемент схемы C<$schema>. 
+
+=over
+
+=item * C<$docName>
+
+Имя корневого узла документа, которое будет использовано для поиска
+соответствующего элемента схемы C<$schema>
+
+=item * C<$schema>
+
+Схема, содержащая описание документа. Если в данной схеме нет описания корневого
+элемента с именем C<$docName>, будет вызвано исключение.
+
+=back
+
+=head2 C<[get]documentSchema>
+
+Элемент схемы C<ComplexNode> соответствующий документу. Определяется в
+конструкторе исходя из имени документа. 
+
+=head2 C<[get]currentNode>
+
+Текущий элемент документа. После создания преобразования - это сам документ.
+Данное свойство использется внутри преобразования для работы с текущим
+элементом.
+
+=head2 C<[virtual]StoreObject($node,$data)>
+
+Метод, который вызывается преобразованием в случае если текущий узел документа
+является простым, а значени которое ему соответсвует является объектом (ссылкой).
+
+По-умолчанию будет выполнено присваивание C<< $node->nodeValue($data) >>, однако
+это можно заменить, например, на преобразование в строку.
+
+=head2 C<inflateNodeValue($data)>
+
+Метод который используется для преобразования значений к правильным типам,
+используя атрибут C<inflator> элемента схемы. Этот метод можно использовать для
+C<TransformPlain>, однако по-умолчанию он не используется, поскольку
+предполагается, что входной объект имеет уже преобразованные значения в своих
+свойствах.
+
 =cut
\ No newline at end of file
--- a/Lib/IMPL/DOM/XMLReader.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/DOM/XMLReader.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -3,12 +3,16 @@
 use warnings;
 
 use parent qw(IMPL::Object IMPL::Object::Autofill);
+
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 use XML::Parser;
-require IMPL::DOM::Schema;
-require IMPL::DOM::Navigator::Builder;
-require IMPL::DOM::Navigator::SimpleBuilder;
+
+use IMPL::require {
+    Schema => 'IMPL::DOM::Schema', # IMPL::DOM::Schema references IMPL::DOM::XML::Reader
+    Builder => 'IMPL::DOM::Navigator::Builder',
+    SimpleBuilder => 'IMPL::DOM::Navigator::SimpleBuilder'
+};
 
 __PACKAGE__->PassThroughArgs;
 
--- a/Lib/IMPL/Object/Singleton.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/Object/Singleton.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -2,15 +2,31 @@
 use strict;
 use warnings;
 
+require IMPL::Exception;
+use parent qw(
+    IMPL::Class::Meta
+);
+
+__PACKAGE__->static_accessor_own(_instance => undef);
+
 my %instances;
 
 sub CTOR {
-    die new IMPL::InvalidOperationException("Only one instance of the singleton can be created",ref $_[0], $instances{ref $_[0]}) if $instances{ref $_[0]};
-    $instances{ref $_[0]} = $_[0];
+    die IMPL::InvalidOperationException->new("Only one instance of the singleton can be created",ref $_[0])
+        if $_[0]->_instance;
 }
 
 sub instance {
-    $instances{$_[0]}
+    my $this = shift;
+    return $this->_instance || $this->_instance($this->Activate());
+}
+
+sub Activate {
+    die IMPL::NotImplementedException->new("Activation isn't implemented", shift);
+}
+
+sub Release {
+    shift->_instance(undef);
 }
 
 1;
@@ -37,18 +53,28 @@
 
 =head1 DESCRIPTION
 
-Реализует шаблон Singleton
+Реализует шаблон Singleton. Наследники данного класса могут иметь только один
+экземпляр. Создать этот экземпляр можно явно, используюя конструктор, либо
+автоматически при обращении к свойству C<instance>, для этого нужно
+переопределить метод C<Activate()>
 
 =head1 MEMBERS
 
-=head2 OPERATORS
+=head2 C<CTOR()>
+
+Проверяет на единственность экземпляра класса, запоминает созданный экземпляр.
 
-=list
+=head2 C<[static,get]instance>
+
+Текущий экземпляр класса, если он еще не создан, то вызывает метод C<Activate>.
 
-=item C<instance CLASS(@params)>
+=head2 C<[static,abstract]Activate()>
 
-Создает или возвращает экземпляр класса, если экземляр не существует, то он создается с параметрами C<@params>.
+Вызывается автоматически при обращении к свойству C<instance>, если экземпляр
+объекта еще не был создан.
 
-=over
+=head2 C<[static]Release()>
+
+Освобождает текущий экземпляр.
 
 =cut
--- a/Lib/IMPL/Web/Handler/SecureCookie.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/Web/Handler/SecureCookie.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -40,6 +40,17 @@
     return 0;
 }
 
+sub AuthCookie {
+    my ($this,$sid,$cookie,$sign, $context) = @_;
+    
+    if (eval { $context->auth->isa(AuthSimple) }) {
+        my ($result,$challenge) = $context->auth->DoAuth($cookie);
+        return $result;
+    }
+    
+    return AUTH_FAIL;
+}
+
 sub Invoke {
     my ($this,$action,$nextHandler) = @_;
     
--- a/Lib/IMPL/Web/View/TTDocument.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/Web/View/TTDocument.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -94,7 +94,7 @@
             my $ctx = new Template::Context($opts);
             
             $factory = new IMPL::Web::View::TTFactory(
-                $template->class || typeof IMPL::Web::View::TTControl,
+                $template->class || TTControl,
                 $template,
                 $ctx,
                 $opts
--- a/Lib/IMPL/require.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/Lib/IMPL/require.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -3,6 +3,8 @@
 use strict;
 #require IMPL::Code::Loader;
 
+use Carp qw(carp);
+
 our %PENDING;
 our $LOADER_LOG;
 
--- a/_test/Resources/TTView/My/Org/Panel.tt	Sat Dec 29 03:22:15 2012 +0400
+++ b/_test/Resources/TTView/My/Org/Panel.tt	Wed Jan 09 05:17:44 2013 +0400
@@ -1,11 +1,12 @@
 [%
     META version = 1;
     BLOCK INIT;
+    # this is a document scope
         dojoDefaultClass = 'dijit.form.Input'; 
         dojo.require.push( dojoDefaultClass );
-        TPreview = require('My/Org/TextPreview');
     END;
     BLOCK CTOR;
+        TPreview = require('My/Org/TextPreview');
         this.dojoClass = this.dojoClass || dojoDefaultClass;
         this.visualClass = this.visualClass || 'classic';
         this.childNodes = [];
--- a/_test/Test/Web/TT.pm	Sat Dec 29 03:22:15 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-package Test::Web::TT;
-use strict;
-use warnings;
-use encoding 'utf8';
-
-use parent qw(IMPL::Test::Unit);
-use IMPL::Test qw(test failed);
-use IMPL::Web::TT::Document;
-
-__PACKAGE__->PassThroughArgs;
-
-test Creation => sub {
-    my $document = new IMPL::Web::TT::Document();
-    
-    failed "Failed to create document" unless $document;
-    
-    $document->Dispose();
-};
-
-test SimpleTemplate => sub {
-    my $document = new IMPL::Web::TT::Document();
-    
-    failed "Failed to create document" unless $document;
-    
-    $document->LoadFile('Resources/simple.tt','utf8');
-    
-    my $out = $document->Render;
-    
-    open my $hFile,'<:encoding(utf8)',"Resources/simple.txt" or die "Failed to open etalon file: $!";
-    local $/;
-    my $eta = <$hFile>;
-    
-    failed "Rendered data doesn't match the etalon data","Expected:\n$eta","Actual:\n$out" if $out ne $eta;
-    
-    $document->Dispose();
-};
-
-
-1;
--- a/_test/Test/Web/View.pm	Sat Dec 29 03:22:15 2012 +0400
+++ b/_test/Test/Web/View.pm	Wed Jan 09 05:17:44 2013 +0400
@@ -131,8 +131,8 @@
     
     assert(defined $factory);
     
-    
-    assert($factory->context->stash != $doc->context->stash);
+    # control factory shares document scope to perform an initialization on demand
+    assert($factory->context->stash == $doc->context->stash);
     
     assert($factory == $doc->RequireControl('My/Org/Panel'), "Control should be loaded only once");
     
@@ -207,7 +207,7 @@
         my $doc = $loader->document('simple');
         my $factory = $doc->RequireControl('My/Org/Panel');
         my $ctl = $doc->childNodes($factory->new('information', { visualClass => 'complex' }) );        
-    });
+    },'dump');
     
     $loader->template('complex');
     AssertMemoryLeak(sub {
--- a/_test/Web.t	Sat Dec 29 03:22:15 2012 +0400
+++ b/_test/Web.t	Wed Jan 09 05:17:44 2013 +0400
@@ -10,7 +10,6 @@
 
 
 run_plan( qw(
-    Test::Web::TT
     Test::Web::View
     Test::Web::AutoLocator
 ) );