# HG changeset patch # User sourcer # Date 1327526157 -14400 # Node ID 47dac58691ee5c091849c8fe65cf1f45c559c6f1 # Parent d1676be8afcc80c8811c00c74c32eb7745a344f5 New templating system, small fixes diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/Exception.pm --- a/Lib/IMPL/Exception.pm Fri Dec 30 23:40:00 2011 +0300 +++ b/Lib/IMPL/Exception.pm Thu Jan 26 01:15:57 2012 +0400 @@ -96,6 +96,14 @@ our @ISA = qw(IMPL::Exception); __PACKAGE__->PassThroughArgs; +package IMPL::KeyNotFoundException; +our @ISA = qw(IMPL::Exception); +__PACKAGE__->PassThroughArgs; + +our %CTOR = ( + 'IMPL::Exception' => sub { "A specified element isn't found", $_[0] } +); + package IMPL::NotImplementedException; our @ISA = qw(IMPL::Exception); __PACKAGE__->PassThroughArgs; diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/Object/Factory.pm --- a/Lib/IMPL/Object/Factory.pm Fri Dec 30 23:40:00 2011 +0300 +++ b/Lib/IMPL/Object/Factory.pm Thu Jan 26 01:15:57 2012 +0400 @@ -3,12 +3,12 @@ use parent qw(IMPL::Object IMPL::Object::Serializable); -use IMPL::Class::Property; +use IMPL::lang qw(:declare :constants); BEGIN { - public property factory => prop_get | owner_set; - public property parameters => prop_get | owner_set; - public property method => prop_get | owner_set; + public property factory => PROP_GET | PROP_OWNERSET; + public property parameters => PROP_GET | PROP_OWNERSET; + public property method => PROP_GET | PROP_OWNERSET; } # custom factory, overrides default @@ -33,7 +33,7 @@ my %args = @$data; if ($surrogate) { - $surrogate->callCTOR($args{factory},$args{parameters},$args{method}); + $surrogate->self::CTOR($args{factory},$args{parameters},$args{method}); return $surrogate; } else { return $class->new($args{factory},$args{parameters},$args{method}); @@ -44,12 +44,19 @@ my $this = shift; if (my $method = $this->method) { - $this->factory->$method($this->parameters ? (_as_list($this->parameters),@_) : @_); + $this->factory->$method($this->MergeParameters(@_)); } else { - $this->factory->new($this->parameters ? (_as_list($this->parameters),@_) : @_); + $this->factory->new($this->MergeParemeters(@_)); } } +sub MergeParameters { + my $this = shift; + + $this->parameters ? (_as_list($this->parameters),@_) : @_; +} + + sub _as_list { ref $_[0] ? (ref $_[0] eq 'HASH' ? @@ -169,6 +176,13 @@ развернуты в список и переданы оператору C< new > фабрике из свойства C< factory >, за ними будут следовать параметры непосредственно текущей фабрики. +=item C + +Метод смешивающий фиксированные параметры с параметрами переданными методу C. По умолчанию +добавляет пареметры фабрики в конец к фиксированным параметрам. Для изменения этого поведения требуется +переопределить данный метод. Также этот метод можно переопределить для передачи параметров, значения +которых вычисляются. + =item C Создает новый объект, используя свйство C как фабрику и передавая туда параметры diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/Web/View/TTControl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/View/TTControl.pm Thu Jan 26 01:15:57 2012 +0400 @@ -0,0 +1,88 @@ +package IMPL::Web::View::TTControl; +use strict; + +use IMPL::DOM::Property qw(_dom); +use IMPL::lang qw(:declare :constants); + +use Template::Context(); + +use parent qw( + IMPL::DOM::Node +); + +my $nextId = 1; + + +BEGIN { + public _dom property id => PROP_ALL; + + public property context => PROP_GET | PROP_OWNERSET; + public property template => PROP_ALL; +} + + +sub CTOR { + my ($this,$name,$template,$context,$refProps) = @_; + + $this->template( $template ) or die new IMPL::ArgumentException("A template is required"); + $this->context( $context ) or die new IMPL::ArgumentException("A context is required"); + + if ( my $ctor = $template->blocks->{CTOR} ) { + $context->process($ctor, { this => $this } ); + } + +} + +our %CTOR = ( + 'IMPL::DOM::Node' => sub { + nodeName => $_[0], + %{ $_[3] || {} } + } +); + +sub Render { + my ($this) = @_; + + if(my $body = $this->template->blocks->{RENDER} ) { + return $this->context->process( $body, { this => $this } ); + } else { + return ""; + } + +} + +1; + +__END__ + +=pod + +=head1 NAME + +C + +=head1 SYNPOSIS + +=head1 DESCRIPTION + +=head2 BLOCKS + +При загрузке шаблона, создается фабрика, с собственным контекстом в которой выполняется шаблон элемента управления + +=head3 INIT + +Данный блок шаблона управления выполняется один раз при создании первого экземпляра элемента управления + +=head3 CTOR + +данный блок выполняется каждый раз при создании нового экземпляра элемента управления, при этом переменная C +указывает на эземпляр элемента упарвления + +=head3 RENDER + + + + +C + +=cut \ No newline at end of file diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/Web/View/TTDocument.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/View/TTDocument.pm Thu Jan 26 01:15:57 2012 +0400 @@ -0,0 +1,178 @@ +package IMPL::Web::View::TTDocument; +use strict; + +use IMPL::lang qw(:declare :constants); +use IMPL::DOM::Property qw(_dom); +use IMPL::Web::View::TTFactory(); +use IMPL::Web::View::TTControl(); + + +use parent qw( + IMPL::DOM::Document + IMPL::Web::View::TTControl +); + +BEGIN { + public _dom property layout => PROP_ALL; + public property opts => PROP_GET | PROP_OWNERSET; + public property loader => PROP_GET | PROP_OWNERSET; + public property controls => PROP_GET | PROP_OWNERSET; +} + +sub CTOR { + my ($this,$template,$refOpts,%args) = @_; + + $this->controls({}); + $this->loader($args{loader}) if $args{loader}; + + $this->layout( $template->layout ) unless $this->layout; + + $this->opts($refOpts); +} + +our %CTOR = ( + 'IMPL::Web::View::TTControl' => sub { + 'document', + $_[0], # template + new Template::Context($_[1]) # context + }, + 'IMPL::DOM::Document' => sub { + nodeName => 'document' + } +); + +sub require { + my ($this, $control) = @_; + + if (! $this->controls->{$control}) { + + (my $path = $control) =~ tr/\./\//; + if ( my $template = $this->loader->template($path) ) { + my $opts = ${$this->opts}; + $opts->{STASH} = $this->context->stash->clone(); + + my $ctx = new Template::Context($opts); + + my $factory = new IMPL::Web::View::TTFactory( + typeof IMPL::Web::View::TTControl, + $template, + $ctx, + $opts + ); + + my @parts = split(/\.+/,$control); + + $this->context->stash->set([map { $_, 0 } @parts], $factory); + + } else { + die new IMPL::KeyNotFoundException($control); + } + + } +} + +sub Render { + my ($this,$param) = @_; + + my $output = $this->context->process($this->template, {this => $this} ); + + if ($this->layout) { + $output = $this->context->include($this->layout,{ content => $output }); + } + + return $output; +} + + +1; + +__END__ + +=pod + +=head1 NAME + +C - документ для построения HTML страницы на основе шаблонов TT. + +=head1 SYNOPSIS + +=begin code + +use IMPL::Web::View::TTDocument(); + +my $doc = new IMPL::Wbe::View::TTDocument($template,$ttOptions); + +return $doc->Render(); + +=end code + +Однако, более предпочтительный способ использовать C. + +=head1 DESCRIPTION + +Документ для представления данных. Документы представляют собой иерархически организованные данные, +элементами данного документа являются данные для отображения, такие как + +=over + +=item * Объекты из БД + +=item * Навигационные цепочки + +=item * Меню и т.п. + +=back + +Скприт шаблона формирует структуру документа, затем сформированная структура форматируется в готовый документ. +Процесс преобразования объектной модели в готовый документ может быть выполнена как вручную, так и при помощи +вспомогательного шаблона - обертки. Если у шаблона документа указан C в метаданных, то он будет +использован как шаблон для форматирования объектной модели, вывод самого шаблона будет проигнорирован. Если +обертка не задана, то результатом будет вывод самого скрипта шаблона. + +Каждый документ имеет свое собственное пространство имен, которое может быть вложенным в некоторое внешнее, +указанное при создании документа. + +=head2 Загрузка элемента управления + +=over + +=item 1 C + +=item 1 Загружает шаблон C + +=item 1 Создает фабрику элементов управления с собственным контекстом, вложенным в контекст документа. + +=item 1 Выполняет шаблон в пространстве имен фабрики + +=item 1 Регистритует фабрику в контексте документа по пути C + +=back + +=head2 Создание элемента управления + +=over + +=item 1 C<< my.org.input.new('login') >> + +=item 1 Если это первый элемент управления, то выполняетя статический конструктор в контексте фабрики + +=item 1 Создается новый дочерний контекст к контексту фабрики + +=item 1 Создается экземпляр элемента управления + +=item 1 Выполняется блок конструктора в контексте элемента управления, параметр C имеет значение +нового экземпляра элемента управления + +=back + +=head1 MEMBERS + +=over + +=item C + +Создает экземпляр документа с указанным шаблоном и параметрами, параметры + +=back + +=cut \ No newline at end of file diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/Web/View/TTFactory.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/View/TTFactory.pm Thu Jan 26 01:15:57 2012 +0400 @@ -0,0 +1,181 @@ +package IMPL::Web::View::TTFactory; +use strict; + +use Template::Context(); + +use IMPL::lang qw(:hash :declare :constants); +use IMPL::Exception(); + + +use parent qw(IMPL::Object::Factory); + +BEGIN { + public property template => PROP_ALL; + public property context => PROP_ALL; + public property opts => PROP_ALL; + public property nodeProperties => PROP_ALL; + public property instances => PROP_GET | PROP_OWNERSET; +} + +__PACKAGE__->PassThroughArgs; + +sub CTOR { + my ($this,$factory,$template,$context,$options,$nodeProps) = @_; + + die IMPL::ArgumentException("A template is required") unless $template; + + $options ||= {}; + + $this->template($template); + $this->context($context || new Template::Context($options)); + $this->opts($options); + $this->nodeProperties($nodeProps || {}); + $this->instances(0); + + # init factory context + $this->context->process($this->template); +} + +our %CTOR = ( + 'IMPL::Object::Factory' => sub { + $_[0] + } +); + +sub MergeParameters { + my ($this,$name,$refProps) = @_; + + my $opts = { $this->opts }; + $opts->{STASH} = $opts->{STASH}->clone() if $opts->{STASH}; + + my $ctx = new Template::Context($opts); + + return ($name, $this->template, $ctx, hashMerge($this->nodeProperties,$refProps)); +} + +sub CreateObject { + my $this = shift; + + my $count = $this->instances; + + unless($count) { + # нужно выполнить именно блок INIT шаблона при создании первого экземпляра + if (my $init = $this->template->blocks->{INIT}) { + $this->context->process($init); + } + } + + $count++; + $this->instances($count); + + return $this->SUPER::CreateObject(@_); +} + +sub save { + die new IMPL::NotImplementedException("This class doesn't support serialization"); +} + +sub restore { + die new IMPL::NotImplementedException("This class doesn't support serialization"); +} + +1; + +__END__ + +=pod + +=head1 NAME + +C - фабрика элементов управления + +=head1 SYNOPSIS + +=begin code + +my $factory = new IMPL::Web::View::TTFactory( + typeof IMPL::Web::View::TTControl, + $doc, + $context, + { + TRIM => 1 + }, + { + myprop => 'my value' + }, +); + +my $input1 = $factory->new('login', { class => "required" } ); + +my $propval = $input->nodeProperty('myprop'); # 'my value' + +=end code + +=begin text + +[% + this.appendChild( + my.org.input.new('login', class = this.errors('login') ? "invalid" : "" ) + ); +%] + +=end text + +=head1 DESCRIPTION + +C< Inherits L > + +=head1 MEMBERS + +=over + +=item C<[get,set]template> + +Документ C который описывает элемент управления. См. C. + +=item C<[get,set]context> + +Контекст фабрики элементов управления, в этом контексте выполняет шаблон элемента управления при загрузке. +Далее в этом контексте будет выполнен блок инициализации при создании первого элемента управления. + +=item C<[get,set]opts> + +Параметры контекста элемента управления (ссылка на хеш). Каждый элемент управления при создании получает свой контекст, +который создает с данными параметрами и хранилищем переменных, дочерним к контексту фабрики. + +=item C<[get,set]nodeProperties> + +Ссылка на хеш со значениями свойств по умолчанию для создаваемого элемента управления. + +=item C<[get]instances> + +Количество созданных элементов управления данной фабрикой + +=item C<[override]MergeParameters($name,$nodeProps)> + +Превращает значения переданные методу C фабрики в параметры для создания элемента управления. + +=over + +=item C<$name> + +Имя создаваемого узла (C). + +=item C<$nodeProps> + +Ссылка на шех со значениями свойств узла. Данные значения будут совмещены со значениями из свойства C + +=back + +=item C<[override]CreateObject(@params)> + +Создает экземпляр элемента управления стандартным образом. Учитывает количество экземпляров и если это первый, +то производит дополнительную инициализацию контекста выполнив блок шаблона C. + +=item C + +Создает элемент управления с указанным именем и набором свойств. + +=back + +=cut \ No newline at end of file diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/Web/View/TTLoader.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/View/TTLoader.pm Thu Jan 26 01:15:57 2012 +0400 @@ -0,0 +1,136 @@ +package IMPL::Web::View::TTLoader; +use strict; + +use IMPL::lang qw(:declare :constants); + +use Template::Provider(); +use Template::Context(); +use Template::Constants qw(:status); + +use IMPL::Web::View::TTDocument(); + +use parent qw( + IMPL::Object +); + +BEGIN { + public property options => PROP_ALL; + public property provider => PROP_GET | PROP_OWNERSET; + public property context => PROP_GET | PROP_OWNERSET; + public property ext => PROP_ALL; + + public property isInitialized => PROP_GET | PROP_OWNERSET; + public property initializer => PROP_GET | PROP_OWNERSET; +} + +sub CTOR { + my ($this,$refOpts,%args) = @_; + + $this->ext(delete $args{etx}); + $this->initializer(delete $args{initializer}); + + $this->options($refOpts); + + $refOpts->{LOAD_TEMPLATES} = $this->provider(new Template::Provider($refOpts)); + + $this->context(new Template::Context($refOpts)); +} + +sub document { + my ($this,$name) = @_; + + my $tt = $this->template($name); + + $this->_init(); + + my $opts = { $this->options }; + + $opts->{STASH} = $this->context->stash->clone(); + $opts->{LOAD_TEMPLATES} = $this->provider; + + return new IMPL::Web::View::TTDocument( $tt, $opts, loader => $this ); +} + +sub template { + my ($this,$name) = @_; + + $name =~ s/^\s+|\s+$//g; + + die new IMPL::ArgumentException("A valid template name is required") unless length $name; + + $name = $this->_appendExt($name); + + my ($tt,$error) = $this->provider->fetch($name); + + if ($error == STATUS_DECLINED) { + die new IMPL::KeyNotFoundException($name); + } elsif ($error == STATUS_ERROR) { + die new IMPL::Exception("Failed to load a template", $name, $tt); + } + + return $tt; +} + +sub _appendExt { + my ($this,$name) = @_; + + + if (length $this->ext and substr( $name, -length($this->ext) ) eq $this->ext) { + return $name; + } else { + return $name . $this->ext; + } +} + +sub _init { + my ($this) = @_; + + if (!$this->isInitialized) { + $this->isInitialized(1); + + if ($this->initializer) { + eval { + $this->context->process($this->initializer); + } + } + } +} + +1; + +__END__ + +=pod + +=head1 NAME + +C - предоставляет глобальный контекст для загрузки шаблонов + +=head1 SYNOPSIS + +=begin code + +use IMPL::Web::View::TTLoader(); + +my $loader = new IMPL::Web::View::TTLoader( + { + INCLUDE_PATH => [ + '/my/app/tt', + '/my/app/tt/lib' + ] + }, + ext => '.tt', + initializer => 'shared/global' + +); + +my $doc = $loader->document('index'); + +my $html = $doc->Render(); + +=end code + +=head1 DESCRIPTION + +=cut + diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/clone.pm --- a/Lib/IMPL/clone.pm Fri Dec 30 23:40:00 2011 +0300 +++ b/Lib/IMPL/clone.pm Thu Jan 26 01:15:57 2012 +0400 @@ -49,7 +49,7 @@ return $_[0] unless ref $_[0]; - return $_[1]->{refaddr($_[0])} || ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_); + return $_[1]->{refaddr($_[0])} || (UNIVERSAL::can($_[0],'_clone') || $handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_); } } diff -r d1676be8afcc -r 47dac58691ee Lib/IMPL/lang.pm --- a/Lib/IMPL/lang.pm Fri Dec 30 23:40:00 2011 +0300 +++ b/Lib/IMPL/lang.pm Thu Jan 26 01:15:57 2012 +0400 @@ -38,7 +38,6 @@ &property &static &property - &ctor ) ], compare => [ @@ -55,6 +54,7 @@ &hashDiff &hashCompare &hashParse + &hashSave ) ] ); @@ -118,20 +118,6 @@ $class->static_accessor( $name, $value ); } -sub ctor(&;$) { - my ( $code, %base ) = @_; - no strict 'refs'; - my $class = caller; - - if ($code) { - *{"${class}::CTOR"} = $code; - } - - if (%base) { - %{"${class}::CTOR"} = %base; - } -} - sub equals { if (defined $_[0]) { return 0 if (not defined $_[1]); @@ -223,7 +209,25 @@ } sub hashSave { + my ($hash,$p,$d) = @_; + return "" unless ref $hash eq 'HASH'; + + $p ||= "\n"; + $d ||= " = "; + + return + join( + $p, + map( + join( + $d, + $_, + $hash->{$_} + ), + keys %$hash + ) + ); } 1; diff -r d1676be8afcc -r 47dac58691ee _doc/make.pl --- a/_doc/make.pl Fri Dec 30 23:40:00 2011 +0300 +++ b/_doc/make.pl Thu Jan 26 01:15:57 2012 +0400 @@ -29,7 +29,7 @@ mkdir $dir unless -d $dir; } - open my $hPod, "<:encoding(cp1251)", $fname or die "Failed to open $fname for input: $!"; + open my $hPod, "<:encoding(utf-8)", $fname or die "Failed to open $fname for input: $!"; open my $hOut, ">:encoding(utf-8)", $fnameOut or die "Failed to open $fnameOut for output: $!"; my $parser = Pod::POM->new(); diff -r d1676be8afcc -r 47dac58691ee _test/Resources/large.out.xml diff -r d1676be8afcc -r 47dac58691ee _test/Test/SQL/Diff.pm --- a/_test/Test/SQL/Diff.pm Fri Dec 30 23:40:00 2011 +0300 +++ b/_test/Test/SQL/Diff.pm Thu Jan 26 01:15:57 2012 +0400 @@ -38,7 +38,7 @@ $users->SetPrimaryKey('id'); $users->AddConstraint( unique => { name => 'unique_login', columns => ['login'] } ); - warn Dumper(IMPL::SQL::Schema::Traits::Diff->Diff($schemaSrc,$schemaDst)); + #warn Dumper(IMPL::SQL::Schema::Traits::Diff->Diff($schemaSrc,$schemaDst)); $schemaSrc->Dispose; $schemaDst->Dispose; diff -r d1676be8afcc -r 47dac58691ee _test/Test/Web/TT.pm --- a/_test/Test/Web/TT.pm Fri Dec 30 23:40:00 2011 +0300 +++ b/_test/Test/Web/TT.pm Thu Jan 26 01:15:57 2012 +0400 @@ -1,7 +1,7 @@ package Test::Web::TT; use strict; use warnings; -use encoding 'cp1251'; +use encoding 'utf8'; use parent qw(IMPL::Test::Unit); use IMPL::Test qw(test failed); @@ -21,11 +21,11 @@ failed "Failed to create document" unless $document; - $document->LoadFile('Resources/simple.tt','cp1251'); + $document->LoadFile('Resources/simple.tt','utf8'); my $out = $document->Render; - open my $hFile,'<:encoding(cp1251)',"Resources/simple.txt" or die "Failed to open etalon file: $!"; + open my $hFile,'<:encoding(utf8)',"Resources/simple.txt" or die "Failed to open etalon file: $!"; local $/; my $eta = <$hFile>; diff -r d1676be8afcc -r 47dac58691ee conv.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/conv.pl Thu Jan 26 01:15:57 2012 +0400 @@ -0,0 +1,19 @@ +#!/usr/bin/perl +use strict; +use File::Find; + +find(sub { + open my $hfile, "<:encoding(cp1251)", $_ or warn "failed: $!" and return; + + my @data = <$hfile>; + + close $hfile; + undef($hfile); + + chomp foreach @data; + + open $hfile, ">:encoding(utf8)", $_ or warn "failed: $!" and return; + + print $hfile "$_\n" foreach @data; + +}, qw(Lib _test _doc)); \ No newline at end of file