Mercurial > pub > Impl
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 {