Mercurial > pub > Impl
changeset 108:c6fb6964de4c
Removed absolute modules
Updated DOM model, selectNodes can now select a complex path
Web DOM model release candidate
author | wizard |
---|---|
date | Fri, 14 May 2010 16:06:06 +0400 |
parents | 0e72ad99eef7 |
children | ddf0f037d460 |
files | Lib/DOM/Page.pm Lib/DOM/Providers/Form.pm Lib/DOM/Providers/Gallery.pm Lib/DOM/Providers/Page.pm Lib/DOM/Providers/Perfomance.pm Lib/DOM/Providers/Security.pm Lib/DOM/Site.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/Schema/Validator/Compare.pm Lib/IMPL/Object/Abstract.pm Lib/IMPL/Web/TT/Control.pm Lib/IMPL/Web/TT/Document.pm |
diffstat | 12 files changed, 103 insertions(+), 897 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/DOM/Page.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,241 +0,0 @@ -package DOM::Page; -use Common; -use Template::Context; -use strict; - -our @ISA = qw(Object); -our $AUTOLOAD; - -BEGIN { - DeclareProperty(Title => ACCESS_ALL); - DeclareProperty(NavChain => ACCESS_READ); - DeclareProperty(Menus => ACCESS_READ); - DeclareProperty(Properties => ACCESS_READ); - DeclareProperty(Template => ACCESS_READ); - DeclareProperty(TemplatesProvider => ACCESS_NONE); - DeclareProperty(Site => ACCESS_READ); -} - -sub CTOR { - my ($this,%args) = @_; - $this->{$Site} = $args{'Site'}; - $this->{$TemplatesProvider} = $args{'TemplatesProvider'}; - $this->{$Properties} = $args{'Properties'} || {}; - $this->{$Title} = $args{'Template'}->Title() || $args{'Properties'}->{'Title'}; - $this->{$Template} = $args{'Template'}; - $this->{$NavChain} = $args{'NavChain'}; - $this->{$Menus} = $args{'Menus'}; -} - -sub Render { - my ($this,$hOut) = @_; - - my $context = new Template::Context({ - VARIABLES => $this->{$Site}->Objects(), - LOAD_TEMPLATES => $this->{$TemplatesProvider} - }); - - print $hOut $this->{$Template}->process($context); -} - -sub Dispose { - my ($this) = @_; - - undef %$this; - - $this->SUPER::Dispose; -} - -sub Container { - my ($this) = @_; - my $nav = $this->{$NavChain}; - return $nav->[@{$nav}-1]; -} - -sub AUTOLOAD { - my $this = shift; - - my $name = $AUTOLOAD; - $name =~ s/.*://; - - return $this->{$Properties}->{$name}; -} - -=pod -Меню - [ - Элемент меню - { - Key => Ключ пункта меню, для быстрого обращения к элементу и слиянии меню - Name => Имя пункта меню, которое будет видель пользователь - Expand => флаг того, что меню выбрано - Value => {[ элемент меню ...] | что-то еще, обычно урл} - } - ] -=cut - -package DOM::PageMenu; -use Common; - -our @ISA = qw(Object); - -BEGIN { - DeclareProperty('Items'); # массив - DeclareProperty('Keys'); # ключи для пунктов меню, если таковые имеются -} - -sub CTOR { - my ($this,%args) = @_; - if (ref $args{'DATA'} eq 'ARRAY') { - foreach my $item (@{$args{'DATA'}}) { - if (ref $item eq 'HASH') { - $this->Append($item->{'Name'},_ProcessData($item->{'Value'}), Expand => $item->{'Expand'}, Key => $item->{'Key'}, Url => $item->{'Url'}); - } elsif (ref $item eq 'ARRAY') { - $this->Append($item->[0],_ProcessData($item->[1]), Expand => $item->[2], Key => $item->[3], Url => $item->[4]); - } - } - } -} - -sub Item { - my ($this,$index) = @_; - - return $this->{$Items}[$index]; -} - -sub ItemByKey { - my ($this,$key) = @_; - - return $this->{$Keys}->{$key}; -} - -sub InsertBefore { - my ($this,$index,$name,$data,%options) = @_; - - my $item = {Name => $name, Value => _ProcessData($data), %options}; - splice @{$this->{$Items}},$index,0,$item; - - if ($options{'Key'}) { - $this->{$Keys}->{$options{'Key'}} = $item; - } -} - -sub Append { - my ($this,$name,$data,%options) = @_; - - my $item = {Name => $name, Value => _ProcessData($data), %options}; - - push @{$this->{$Items}},$item; - - if ($options{'Key'}) { - $this->{$Keys}->{$options{'Key'}} = $item; - } -} - -sub SubMenu { - my ($this,$path) = @_; - my $item = $this; - foreach my $key ( split /\/+/,$path ) { - $item = $item->{$Keys}->{$key}; - if (not $item ) { - die new Exception('Item does\'t exist', $path, $key); - } - $item = $item->{Value}; - if (not UNIVERSAL::isa($item,'DOM::PageMenu')) { - $item = ($this->{$Keys}->{$key}->{Value} = new DOM::PageMenu()); - } - } - - return $item; -} - -sub Dump { - use Data::Dumper; - - return Dumper(shift); -} - -sub AppendItem { - my ($this,$item) = @_; - - push @{$this->{$Items}},$item; - - if ($item->{'Key'}) { - $this->{$Keys}->{$item->{'Key'}} = $item; - } -} - -sub RemoveAt { - my ($this,$index) = @_; - - my $item = splice @{$this->{$Items}},$index,1; - - if ($item->{'Key'}) { - delete $this->{$Keys}->{$item->{'Key'}}; - } - - return 1; -} - -sub ItemsCount { - my $this = shift; - return scalar(@{$this->{$Items}}); -} - -sub Sort { - my $this = shift; - - $this->{$Items} = \sort { $a->{'Name'} <=> $b->{'Name'} } @{$this->{$Items}}; - - return 1; -} - -sub as_list { - my $this = shift; - return $this->{$Items} || []; -} - -sub Merge { - my ($this,$that) = @_; - - foreach my $itemThat ($that->Items) { - my $itemThis = $itemThat->{'Key'} ? $this->{$Keys}->{$itemThat->{'Key'}} : undef; - if ($itemThis) { - $this->MergeItems($itemThis,$itemThat); - } else { - $this->AppendItem($itemThat); - } - } -} - -sub MergeItems { - my ($this,$itemLeft,$itemRight) = @_; - - while (my ($prop,$value) = each %{$itemRight}) { - if ($prop eq 'Value') { - if (UNIVERSAL::isa($itemLeft->{$prop},__PACKAGE__) && UNIVERSAL::isa($value,__PACKAGE__)) { - $itemLeft->{$prop}->Merge($value); - } else { - $itemLeft->{$prop} = $value if defined $value; - } - } else { - $itemLeft->{$prop} = $value if defined $value; - } - } - - return 1; -} - -sub _ProcessData { - my $refData = shift; - - if (ref $refData eq 'ARRAY') { - return new DOM::PageMenu(DATA => $refData); - } else { - return $refData; - } -} - - - -1;
--- a/Lib/DOM/Providers/Form.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -package Configuration; -our $DataDir; -package DOM::Providers::Form; -use strict; -use Form; -use Schema::Form; -use Common; -our @ISA = qw(Object); - -our $Encoding ; -our $CacheDir ||= "${DataDir}Cache/"; -warn "The encoding for the DOM::Provider::Form isn't specified" if not $Encoding; -$Encoding ||= 'utf-8'; - -sub GetProviderInfo { - return { - Name => 'Form', - Host => 'DOM::Site', - Methods => { - LoadForm => \&SiteLoadForm - } - } -} - -BEGIN { - DeclareProperty FormsEncoding => ACCESS_READ; - DeclareProperty DataCacheDir => ACCESS_READ; -} - -sub SiteLoadForm { - my ($this,$site,$file,$form) = @_; - return $site->RegisterObject('Form',$this->LoadForm($file,$form)); -} - -sub LoadForm { - my ($this,$file, $formName) = @_; - - my $formSchema = Schema::Form->LoadForms($file,$this->{$DataCacheDir},$this->{$FormsEncoding})->{$formName} or die new Exception('The form isn\'t found',$formName,$file); - return Form->new($formSchema); -} - -sub construct { - my ($class) = @_; - - return $class->new(FormsEncoding => $Encoding, DataCacheDir => $CacheDir); -} - - -1;
--- a/Lib/DOM/Providers/Gallery.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -use strict; -package DOM::Gallery; -use Common; -our @ISA = qw(Object); - -BEGIN { - DeclareProperty(Id => ACCESS_READ); - DeclareProperty(Name => ACCESS_READ); - DeclareProperty(Description => ACCESS_READ); - DeclareProperty(Images => ACCESS_READ); - DeclareProperty(CurrentImage => ACCESS_READ); - DeclareProperty(NextImage => ACCESS_READ); - DeclareProperty(PrevImage => ACCESS_READ); -} - -sub CTOR { - my ($this,%args) = @_; - - $this->{$Id} = $args{'Id'}; - $this->{$Name} = $args{'Name'}; - $this->{$Description} = $args{'Description'}; -} - -sub GroupList { - my ($this,$GroupCount, $option) = @_; - - my @images = map { $this->{$Images}->{$_} } sort keys %{$this->{$Images}}; - - my @listGroups; - my $group; - for (my $i = 0; $i < $GroupCount; $i++ ) { - #last unless scalar(@images) or $option =~ /align/i; - push (@$group, shift(@images)); - if ($i == $GroupCount - 1) { - push @listGroups, $group; - undef $group; - $i = -1; - last if not scalar(@images); - } - } - - return \@listGroups; -} - -sub SelectImage { - my ($this,$imageId) = @_; - - my @images = sort keys %{$this->{$Images}}; - - for (my $i=0; $i <= @images; $i++) { - if ($images[$i] eq $imageId) { - $this->{$CurrentImage} = $this->{$Images}->{$images[$i]}; - $this->{$PrevImage} = $i-1 >= 0 ? $this->{$Images}->{$images[$i-1]} : undef; - $this->{$NextImage} = $i+1 < @images ? $this->{$Images}->{$images[$i+1]} : undef; - return 1; - } - } - die new Exception("An image '$imageId' not found in the gallery '$this->{$Id}'"); -} - -sub AddImage { - my ($this,$image) = @_; - - $this->{$Images}->{$image->Id()} = $image; -} - -package DOM::Gallery::Image; -use Common; -our @ISA = qw(Object); -BEGIN { - DeclareProperty(Id => ACCESS_READ); - DeclareProperty(Name => ACCESS_READ); - DeclareProperty(Gallery => ACCESS_READ); - DeclareProperty(URL => ACCESS_READ); - DeclareProperty(ThumbURL => ACCESS_READ); -} - -sub CTOR { - my ($this,%args) = @_; - - $this->{$Id} = $args{'Id'} or die new Exception ('An Id should be specified for an image'); - $this->{$Name} = $args{'Name'}; - $this->{$Gallery} = $args{'Gallery'} or die new Exception('An Gallery should be specified for an image'); - $this->{$URL} = $args{'URL'}; - $this->{$ThumbURL} = $args{'ThumbURL'}; -} - -package DOM::Providers::Gallery; -use Common; -our @ISA = qw(Object); - -our $RepoPath; -our $ImagesURL; -our $Encoding; - -BEGIN { - DeclareProperty(GalleryCache => ACCESS_NONE); - DeclareProperty(Repository => ACCESS_NONE); -} - -sub CTOR { - my ($this,%args) = @_; - - $this->{$Repository} = $args {'Repository'} or die new Exception('A path to an galleries repository should be specified'); -} - -sub GetProviderInfo() { - return { - Name => 'Gallery', - Host => 'DOM::Site', - Methods => { - LoadGallery => \&SiteLoadGallery #($this,$site,$galleryId) - } - }; -} - -sub SiteLoadGallery { - my ($this,$site,$galleryId) = @_; - - my $gallery = $this->LoadGallery($galleryId); - - $site->RegisterObject('Gallery',$gallery); - - return $gallery; -} - -sub LoadGallery { - my ($this,$galleryId) = @_; - - die new Exception("Invalid Gallery Id: $galleryId") if $galleryId =~ /\\|\//; - - my $galleryIdPath = $galleryId; - $galleryIdPath =~ s/\./\//g; - - my $GalleryPath = $this->{$Repository} . $galleryIdPath .'/'; - - die new Exception("A gallery '$galleryId' isn't found",$GalleryPath) if not -d $GalleryPath; - - open my $hDesc, "<:encoding($Encoding)", $GalleryPath.'index.htm' or die new Exception("Invalid gallery: $galleryId","Failed to open ${GalleryPath}index.htm: $!"); - - my $GalleryName; - while (<$hDesc>) { - if (/<title>(.+?)<\/title>/i) { - $GalleryName = $1; - last; - } - } - undef $hDesc; - - my $ImagesPath = $GalleryPath.'images/'; - my $ThumbsPath = $GalleryPath.'thumbnails/'; - - opendir my $hImages, $ImagesPath or die new Exception("Invalid gallery: $galleryId","Can't open images repository: $!"); - - my @imageIds = grep { -f $ImagesPath.$_ } readdir $hImages; - - my %imageNames; - - if (-f $GalleryPath.'description.txt') { - local $/="\n"; - if (open my $hfile,"<:encoding($Encoding)",$GalleryPath.'description.txt') { - while (<$hfile>) { - chomp; - my ($id,$name) = split /\s*=\s*/; - $imageNames{$id} = $name; - } - } - } - - undef $hImages; - - if ($Common::Debug) { - foreach (@imageIds) { - warn "A tumb isn't found for an image: $_" if not -f $ThumbsPath.$_; - } - } - - my $gallery = new DOM::Gallery(Id => $galleryId, Name => $GalleryName); - - foreach my $imageId (@imageIds) { - $gallery->AddImage(new DOM::Gallery::Image( - Id => $imageId, - URL => $ImagesURL.$galleryIdPath.'/images/'.$imageId, - ThumbURL => $ImagesURL.$galleryIdPath.'/thumbnails/'.$imageId, - Gallery => $gallery, - Name => $imageNames{$imageId} - ) - ); - } - - return $gallery; -} - -sub construct { - my $self = shift; - - return new DOM::Providers::Gallery( Repository => $RepoPath); -} - -1;
--- a/Lib/DOM/Providers/Page.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,258 +0,0 @@ -use strict; - -package DOM::Providers::Page; -use Template::Provider; -#use PerfCounter; -use DOM::Page; -use Common; -use Encode; - -our @ISA= qw(Object Exporter); - -our $UseIndexPage; #optional -our $PagesPath; #required -our $IncludesPath; #optional -our $CacheSize; #optional -our $CachePath; #optional -our $Encoding; #optional -our $AllowExtPath; #optional -our $PageResolver; #optional - - -BEGIN { - DeclareProperty('PageResolver'); - DeclareProperty('PagesBase'); - DeclareProperty('IndexPage'); - DeclareProperty('TemplatesProvider'); - DeclareProperty('PageEnc'); -} - -sub as_list { - return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ ); -} - -sub GetProviderInfo { - return { - Name => 'Page', - Host => 'DOM::Site', - Methods => { - LoadPage => \&SiteLoadPage, - ReleasePage => \&SiteReleasePage, - } - } -} - -sub CTOR { - my ($this,%args) = @_; - - $this->{$PageResolver} = $args{'PageResolver'}; - $this->{$PagesBase} = $args{'TemplatesPath'}; - $this->{$IndexPage} = $args{'IndexPage'} || 'index.html'; - $this->{$PageEnc} = $args{'Encoding'}; - $this->{$TemplatesProvider} = new Template::Provider( INCLUDE_PATH => [$this->{$PagesBase}, as_list($args{'IncludePath'}) ], COMPILE_DIR => $args{'CachePath'}, CACHE_SIZE => $args{'CacheSize'}, ENCODING => $args{'Encoding'}, ABSOLUTE => $AllowExtPath, RELATIVE => $AllowExtPath, INTERPOLATE => 1, PRE_CHOMP => 3); -} - -sub ResolveId { - my ($this,$pageId) = @_; - - if ($this->{$PageResolver} && UNIVERSAL::can($this->{$PageResolver},'ResolveId')) { - return $this->{$PageResolver}->ResolveId($pageId); - } else { - return grep { $_ } split /\//,$pageId; - } -} - -sub MakePageId { - my ($this,$raPath) = @_; - - if ($this->{$PageResolver} && UNIVERSAL::can($this->{$PageResolver},'MakeId')) { - return $this->{$PageResolver}->MakeId($raPath); - } else { - return join '/',@$raPath; - } -} - -sub PageIdToURL { - my ($this,$pageId) = @_; - - if ($this->{$PageResolver} && UNIVERSAL::can($this->{$PageResolver},'PageIdToURL')) { - return $this->{$PageResolver}->PageIdToURL($pageId); - } else { - return '/'.$pageId; - } -} - -sub SiteLoadPage { - my ($this,$site,$pageId) = @_; - - return $site->RegisterObject('Page', $this->LoadPage($pageId, Site => $site)); -} -sub LoadPage { - my ($this,$pageId,%args) = @_; - - #StartTimeCounter('LoadPageTime'); - - my @pathPage = $this->ResolveId($pageId); - - my $pageNode = $this->LoadNode(\@pathPage); - - pop @pathPage; - - my @pathNode; - - # поскольку путь указан относительно корневого контейнера, то нужно его добавить в начало - my @NavChain = map { push @pathNode, $_; $this->LoadNode(\@pathNode); } ('.',@pathPage); - - if ($pageNode->{'Type'} eq 'Section') { - push @NavChain,$pageNode; - $pageNode = $this->LoadNode($pageNode->{'pathIndexPage'}); - } - - # формируем меню страницы - my %PageMenus; - foreach my $MenuSet (map { $_->{'Menus'}} @NavChain, $pageNode->{'Menus'} ) { - foreach my $menuName (keys %$MenuSet) { - if ($PageMenus{$menuName}) { - $PageMenus{$menuName}->Merge($MenuSet->{$menuName}); - } else { - $PageMenus{$menuName} = $MenuSet->{$menuName}; - } - } - } - - # формируем ключевые слова и свойства - my @keywords; - my %Props; - foreach my $PropSet ( (map { $_->{'Props'}} @NavChain), $pageNode->{'Props'} ) { - if(ref $PropSet->{'Keywords'} eq 'ARRAY') { - push @keywords, @{$PropSet->{'Keywords'}}; - } elsif (not ref $PropSet->{'Keywords'} and exists $PropSet->{'Keywords'}) { - push @keywords, $PropSet->{'Keywords'}; - } - - while (my ($prop,$value) = each %$PropSet) { - next if $prop eq 'Keywords'; - $Props{$prop} = $value; - } - } - - #StopTimeCounter('LoadPageTime'); - # загружаем шаблон - - #StartTimeCounter('FetchTime'); - my ($Template,$error) = $this->{$TemplatesProvider}->fetch($pageNode->{'TemplateFileName'}); - die new Exception("Failed to load page $pageId",$Template ? $Template->as_string : 'Failed to parse') if $error; - #StopTimeCounter('FetchTime'); - - my $page = new DOM::Page(TemplatesProvider => $this->{$TemplatesProvider}, Properties => \%Props, Menus => \%PageMenus, NavChain => \@NavChain, Template => $Template, %args); - $page->Properties->{url} = $this->PageIdToURL($pageId); - return $page; -} - -sub LoadNode { - my ($this,$refNodePath) = @_; - - my $fileNameNode = $this->{$PagesBase} . join('/',grep $_, @$refNodePath); - my $fileNameMenus; - my $fileNameProps; - - my %Node; - - if ( -d $fileNameNode ) { - $Node{'Type'} = 'Section'; - $fileNameMenus = $fileNameNode . '/.menu.pl'; - $fileNameProps = $fileNameNode . '/.prop.pl'; - } elsif ( -e $fileNameNode ) { - $Node{'Type'} = 'Page'; - $Node{'TemplateFileName'} = join('/',@$refNodePath);; - $fileNameMenus = $fileNameNode . '.menu.pl'; - $fileNameProps = $fileNameNode . '.prop.pl'; - } else { - die new Exception("Page not found: $fileNameNode"); - } - - if ( -f $fileNameProps ) { - local ${^ENCODING}; - my $dummy = ''; - open my $hnull,'>>',\$dummy; - local (*STDOUT,*STDIN) = ($hnull,$hnull); - $Node{'Props'} = do $fileNameProps or warn "can't parse $fileNameProps: $@"; - } - - if ( -f $fileNameMenus ) { - local ${^ENCODING}; - my $dummy = ''; - open my $hnull,'>>',\$dummy; - local (*STDOUT,*STDIN) = ($hnull,$hnull); - $Node{'Menus'} = do $fileNameMenus or warn "can't parse $fileNameMenus: $@"; - } - - if ($Node{'Menus'}) { - my %Menus; - foreach my $menu (keys %{$Node{'Menus'}}) { - $Menus{$menu} = new DOM::PageMenu( DATA => $Node{'Menus'}->{$menu} ); - } - $Node{'Menus'} = \%Menus; - } - - $Node{'pathIndexPage'} = [@$refNodePath, $Node{'Props'}->{'IndexPage'} || $this->{$IndexPage}] if $Node{'Type'} eq 'Section'; - - return \%Node; -} - -sub SiteReleasePage { - my ($this,$site) = @_; - - my $page = $site->Objects()->{'Page'}; - $page->Release() if $page; - - return 1; -} - -sub construct { - my $self = shift; - - return new DOM::Providers::Page(TemplatesPath => $PagesPath, IncludePath => $IncludesPath, IndexPage => $UseIndexPage, CachePath => $CachePath, CacheSize => $CacheSize, Encoding => $Encoding); -} - -sub DecodeData { - my ($Encoding, $data) = @_; - - if (ref $data) { - if (ref $data eq 'SCALAR') { - my $decoded = Encode::decode($Encoding,$$data,Encode::LEAVE_SRC); - return \$decoded; - } elsif (UNIVERSAL::isa($data, 'HASH')) { - return {map {Encode::decode($Encoding,$_,Encode::LEAVE_SRC),DecodeData($Encoding,$data->{$_})} keys %$data }; - } elsif (UNIVERSAL::isa($data, 'ARRAY')) { - return [map {DecodeData($Encoding,$_)} @$data]; - } elsif (ref $data eq 'REF') { - my $decoded = DecodeData($Encoding,$$data); - return \$decoded; - } else { - die new Exception('Cant decode data type', ref $data); - } - } else { - return Encode::decode($Encoding,$data,Encode::LEAVE_SRC); - } -} - -1; - -=pod -Хранилище шаблонов на основе файловой системы. - -Хранилище состоит из разделов, каждый раздел имеет набор свойств и меню -Специальны свойства разделов - Keywords Ключевые слова - Name Название - IndexPage страница по умолчанию - -В разделах находятся страницы, каждая страница имеет набор свойств и меню - -При загрузке страницы полностью загружаются все родительские контейнеры, -При этом одноименные меню сливаются, -Свойства keywords объеъединяются, -Если имя страницы не задано, то используется имя раздела - -=cut
--- a/Lib/DOM/Providers/Perfomance.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -use strict; - -package DOM::Providers::Perfomance; -use PerfCounter; - -sub GetProviderInfo { - return { - Name => 'Perfomance', - Host => 'DOM::Site', - Objects => { - Counters => \%PerfCounter::Counters - } - } -} -1;
--- a/Lib/DOM/Providers/Security.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -use strict; - -package DOM::Providers::Security; -use Security; - -sub GetProviderInfo { - return { - Name => 'Security', - Host => 'DOM::Site', - Objects => { - Session => \&GetSession - } - } -} - -sub GetSession { - return Security->CurrentSession; -} -1;
--- a/Lib/DOM/Site.pm Thu May 13 03:46:29 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,80 +0,0 @@ -package DOM::Site; -use strict; -use Common; -our @ISA = qw(Object); - -our $Name; -our @Providers; -our $AUTOLOAD; - -BEGIN { - DeclareProperty(Objects => ACCESS_READ); - DeclareProperty(Providers => ACCESS_NONE); -} - -sub RegisterObject { - my ($this,$name,$object) = @_; - - $this->{$Objects}->{$name} = $object; -} - -sub RegisterProvider { - my ($this,$provider) = @_; - - my $refInfo = $provider->GetProviderInfo(); - - if ($refInfo->{'Host'} eq __PACKAGE__) { - die new Exception("Provider $refInfo->{'Name'} already registered") if exists $this->{$Providers}->{$refInfo->{'Name'}}; - while (my ($name,$method) = each %{$refInfo->{'Methods'}}) { - no strict 'refs'; - no warnings 'redefine'; - *{__PACKAGE__ . '::' . $name} = sub { - shift; - $method->($provider,$this,@_); - }; - } - - while (my ($name,$object) = each %{$refInfo->{'Objects'}}) { - $this->{$Objects}->{$refInfo->{'Name'}}->{$name} = $object; - } - - $this->{$Providers}->{$refInfo->{'Name'}} = 1; - } -} - -sub construct { - my $self = shift; - - my $site = $self->new(); - $site->RegisterObject(Site => { Name => $Name}); - foreach my $provider (@Providers) { - my $providerFile = $provider; - $providerFile =~ s/::/\//g; - $providerFile .= '.pm'; - eval { - require $providerFile; - }; - if ($@) { - my $InnerErr = $@; - die new Exception("Failed to load provider $provider", $InnerErr); - } - if ($provider->can('construct')) { - $site->RegisterProvider($provider->construct()); - } else { - $site->RegisterProvider($provider); - } - } - return $site; -} - -sub Dispose { - my ($this) = @_; - - UNIVERSAL::can($_,'Dispose') and $_->Dispose foreach values %{$this->{$Objects} || {}}; - - undef %$this; - - $this->SUPER::Dispose; -} - -1;
--- a/Lib/IMPL/DOM/Node.pm Thu May 13 03:46:29 2010 +0400 +++ b/Lib/IMPL/DOM/Node.pm Fri May 14 16:06:06 2010 +0400 @@ -183,7 +183,29 @@ } sub selectNodes { - my ($this,$query,$axis) = @_; + my $this = shift; + my ($path) = @_; + + $path = ref $path eq 'ARRAY' ? $path : ( @_ == 1 ? $this->translatePath($path) : [@_]); + + my @set = ($this); + + while (my $query = shift @$path) { + @set = map $_->selectNodesAxis($query), @set; + } + + return wantarray ? @set : \@set; +} + +sub translatePath { + my ($this,$path) = @_; + + # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare + return [$path]; +} + +sub selectNodesAxis { + my ($this,$query,$axis) = @_; $axis ||= 'child'; @@ -200,7 +222,7 @@ @result = grep $keys{$_->nodeName}, @{$nodes}; } elsif (ref $query eq 'HASH') { while( my ($axis,$filter) = each %$query ) { - push @result, $this->selectNodes($filter,$axis); + push @result, $this->selectNodesAxis($filter,$axis); } } elsif (defined $query) { @result = grep $_->nodeName eq $query, @{$nodes}; @@ -211,18 +233,6 @@ return wantarray ? @result : \@result; } -sub selectPath { - my ($this,$path) = @_; - - my @set = ($this); - - while (my $query = shift @$path) { - @set = map $_->selectNodes($query), @set; - } - - return wantarray ? @set : \@set; -} - sub selectParent { my ($this) = @_;
--- a/Lib/IMPL/DOM/Schema/Validator/Compare.pm Thu May 13 03:46:29 2010 +0400 +++ b/Lib/IMPL/DOM/Schema/Validator/Compare.pm Fri May 14 16:06:06 2010 +0400 @@ -114,7 +114,7 @@ my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath)); - my ($foreignNode) = $node->selectPath($query); + my ($foreignNode) = $node->selectNodes($query); my $Source = $ctx && $ctx->{Source} || $this->parentNode;
--- a/Lib/IMPL/Object/Abstract.pm Thu May 13 03:46:29 2010 +0400 +++ b/Lib/IMPL/Object/Abstract.pm Fri May 14 16:06:06 2010 +0400 @@ -112,7 +112,7 @@ our $AUTOLOAD; sub AUTOLOAD { - goto &{caller(). substr $AUTOLOAD,4}; + goto &{caller(). substr $AUTOLOAD,6}; } package supercall;
--- a/Lib/IMPL/Web/TT/Control.pm Thu May 13 03:46:29 2010 +0400 +++ b/Lib/IMPL/Web/TT/Control.pm Fri May 14 16:06:06 2010 +0400 @@ -1,12 +1,13 @@ package IMPL::Web::TT::Control; -use base qw(IMPL::DOM::Node); +use base qw(IMPL::Web::TT::Collection); use IMPL::Class::Property; __PACKAGE__->PassThroughArgs; BEGIN { + public property controlClass => prop_all; public property template => prop_all; public property id => prop_all; } @@ -18,6 +19,7 @@ $this->template($args{template}) if $args{template}; $this->id($this->nodeName . '-' . $nextId++); + $this->controlClass($args{controlClass} || 'Control'); } sub Render {
--- a/Lib/IMPL/Web/TT/Document.pm Thu May 13 03:46:29 2010 +0400 +++ b/Lib/IMPL/Web/TT/Document.pm Fri May 14 16:06:06 2010 +0400 @@ -16,7 +16,7 @@ private property _context => prop_all; public property template => prop_get | owner_set; public property presenter => prop_all, { validate => \&_validatePresenter }; - public property controls => { get => \&_getControls }; + private property _controlClassMap => prop_all; } our %CTOR = ( @@ -26,11 +26,25 @@ sub CTOR { my ($this) = @_; - $this->appendChild( - $this->Create( - controls => 'IMPL::Web::TT::Collection' - ) - ) + $this->_controlClassMap({}); + $this->registerControlClass( Control => 'IMPL::Web::TT::Control' ); + $this->appendChild( $this->Create(body => 'IMPL::Web::TT::Collection') ); + $this->appendChild( $this->Create(head => 'IMPL::Web::TT::Collection') ); +} + +sub CreateControl { + my ($this,$name,$class,$args) = @_; + + $args = {} unless ref $args eq 'HASH'; + + if (my $info = $this->_controlClassMap->{$class}) { + my %nodeArgs = (%{$info->{args}},%$args); + $nodeArgs{controlClass} = $class; + + return $this->Create($name,$info->{type},\%nodeArgs); + } else { + die new IMPL::Exception('A control is\'t registered', $class, $name); + } } sub provider { @@ -58,8 +72,7 @@ this => $this, render => sub { $this->_process(@_); - }, - controls => $this->controls + } }, TRIM => 1, RECURSION => 1, @@ -69,11 +82,22 @@ } } -sub createControl { - my ($this,$name,$args) = @_; +sub registerControlClass { + my ($this, $controlClass, $type, $args) = @_; + + $type ||= 'IMPL::Web::TT::Control'; + + die new IMPL::InvalidArgumentException("A controlClass must be a single word",$controlClass) unless $controlClass =~ /^\w+$/; - my $node = $this->Create($name,'IMPL::Web::TT::Control',$args); - $this->controls->appendChild($node); + eval "require $type; 1;" or die new IMPL::Exception("Failed to load a module",$type,"$@") unless ref $type or $INC{$type}; + + die new IMPL::InvalidArgumentException("A type must be subclass of IMPL::DOM::Node",$type) unless $type->isa('IMPL::DOM::Node'); + + $this->_controlClassMap->{$controlClass} = { + controlClass => $controlClass, + type => $type, + args => ref $args eq 'HASH' ? $args : {} + }; } sub _getControls { @@ -153,6 +177,26 @@ return join '',@result; } +our $AUTOLOAD; +sub AUTOLOAD { + my $this = shift; + my ($method) = ($AUTOLOAD =~ /(\w+)$/); + + if($method =~ /^create(\w+)/) { + my ($name,$args) = @_; + return $this->CreateControl($name,$1,$args); + } + + my @result = $this->selectNodes($method); + + return $result[0] if @result; + return; +} + +sub as_list { + $_[0]->childNodes; +} + sub Dispose { my ($this) = @_; @@ -160,7 +204,7 @@ $this->_context(undef); $this->_provider(undef); - $this->SUPER::Dispose(); + $this->supercall::Dispose(); } 1; @@ -223,17 +267,30 @@ =head1 DOM +Документ представляет собой DOM документ, состоящий из узлов, которые представляют собой данные +для отображения. Для форматированого вывода используется C<template>. + +В качестве элементов документа могут присутсвовать специальные объекты C<IMPL::Web::TT::Control>, +которые внутри содержат шаблон для форматирования собственного содержимого. + + + +Документ предоставляет ряд фнукций для работы с элементами управления. + +=head1 TEMPLATE + =begin code html -[% table = document.Create('env','table') %] +[% CALL document.registerClass( 'Table', 'My::TableClass', template => 'tables/pretty.tt' ) %] +[% CALL document.registerClass( 'Form' )%] + +[% table = document.сreateTable('env') %] [% FOEACH item in document.result %] [% table.rows.Add( item.get('name','value') ) %] [% END %] -[% form = document.Create('login','form') %] - - +[% form = document.createForm('login') %] [% form.template = 'LOGIN_FORM'%] [% FOREACH item IN document.childNodes %] @@ -248,5 +305,4 @@ =end code html - =cut