# HG changeset patch # User wizard # Date 1276013565 -14400 # Node ID a7efb31172957c4678ec588db46dd7022ce958ff # Parent 92c850d0bdb995c359b6884dc1228df3f9bda4a8 Fixed bug in IMPL::DOM::Navigator::selectNodes Fixed bug in IMPL::DOM::Node::selectNodes renamed operator 'type' to 'typeof' in IMPL::Object::Abstract A proper implementation of the IMPL::DOM::Node::nodeProperty and a related changes in the IMPL::DOM::Property module, now the last is very simple. diff -r 92c850d0bdb9 -r a7efb3117295 Lib/IMPL/DOM/Navigator.pm --- a/Lib/IMPL/DOM/Navigator.pm Tue Jun 08 03:38:10 2010 +0400 +++ b/Lib/IMPL/DOM/Navigator.pm Tue Jun 08 20:12:45 2010 +0400 @@ -70,18 +70,7 @@ sub selectNodes { my ($this,@path) = @_; - return internalSelectNodes($this->Current,@path); -} - -sub internalSelectNodes { - my $node = shift; - my $query = shift; - - if (@_) { - return map internalSelectNodes($_,@_), $node->selectNodes($query); - } else { - return $node->selectNodes($query); - } + return $this->Current->selectNodes(@path); } sub internalNavigateNodeSet { diff -r 92c850d0bdb9 -r a7efb3117295 Lib/IMPL/DOM/Node.pm --- a/Lib/IMPL/DOM/Node.pm Tue Jun 08 03:38:10 2010 +0400 +++ b/Lib/IMPL/DOM/Node.pm Tue Jun 08 20:12:45 2010 +0400 @@ -191,13 +191,18 @@ sub selectNodes { my $this = shift; - my ($path) = @_; + my $path; - $path = ref $path eq 'ARRAY' ? $path : ( @_ == 1 ? $this->translatePath($path) : [@_]); + if (@_ == 1) { + $path = $this->translatePath($_[0]); + } else { + $path = [@_]; + } my @set = ($this); - while (my $query = shift @$path) { + while (@$path) { + my $query = shift @$path; @set = map $_->selectNodesAxis($query), @set; } @@ -341,14 +346,26 @@ my $this = shift; my $name = shift; + if (my $method = $this->can($name)) { + return &$method($this,@_); + } + if (@_) { - # set - return $this->{$_propertyMap}{$name} = shift; - } else { - return $this->{$_propertyMap}{$name}; + # set + return $this->{$_propertyMap}{$name} = shift; + } else { + return $this->{$_propertyMap}{$name}; } } +sub listProperties { + my ($this) = @_; + + my %props = map {$_->Name, 1} $this->get_meta(typeof IMPL::Class::PropertyInfo, sub { $_->Attributes->{domProperty}},1); + + return (keys %props,keys %{$this->{$_propertyMap}}); +} + sub qname { $_[0]->{$nodeName}; } diff -r 92c850d0bdb9 -r a7efb3117295 Lib/IMPL/DOM/Property.pm --- a/Lib/IMPL/DOM/Property.pm Tue Jun 08 03:38:10 2010 +0400 +++ b/Lib/IMPL/DOM/Property.pm Tue Jun 08 20:12:45 2010 +0400 @@ -2,7 +2,6 @@ use strict; use warnings; -use IMPL::Class::Property; require IMPL::Exception; use base qw(Exporter); @@ -10,44 +9,10 @@ sub _dom($) { my ($prop_info) = @_; - $prop_info->Implementor( 'IMPL::DOM::Property' ); + $prop_info->Attributes->{domProperty} = 1; return $prop_info; } -sub Make { - my ($self,$propInfo) = @_; - - my ($class,$name,$virt,$access,$mutators) = $propInfo->get qw(Class Name Virtual Access Mutators); - - die new IMPL::InvalidOperationException("DOM properties can be declared only for the DOM objects") unless $class->isa('IMPL::DOM::Node'); - - no strict 'refs'; - die new IMPL::InvalidOperationException("Custom mutators are not allowed","${class}::$name") if ref $mutators; - if (($mutators & prop_all) == prop_all) { - *{"${class}::$name"} = sub { - $_[0]->nodeProperty($name,@_[1..$#_]); - }; - $propInfo->canGet(1); - $propInfo->canSet(1); - } elsif( $mutators & prop_get ) { - *{"${class}::$name"} = sub { - die new IMPL::InvalidOperationException("This is a readonly property", "${class}::$name") if @_>1; - $_[0]->nodeProperty($name); - }; - $propInfo->canGet(1); - $propInfo->canSet(0); - } elsif( $mutators & prop_set ) { - *{"${class}::$name"} = sub { - die new IMPL::InvalidOperationException("This is a writeonly property", "${class}::$name") if @_<2; - $_[0]->nodeProperty($name,@_[1..$#_]); - }; - $propInfo->canGet(0); - $propInfo->canSet(1); - } else { - die new IMPL::InvalidOperationException("Invalid value for the property mutators","${class}::$name",$mutators); - } -} - 1; __END__ =pod @@ -67,7 +32,6 @@ =head1 DESCRIPTION -Позволяет объявлять свойства, которые будут храниться в списке динамических -свойств. +Позволяет объявлять свойства, которые будут видны в списке свойств. =cut diff -r 92c850d0bdb9 -r a7efb3117295 Lib/IMPL/Object/Abstract.pm --- a/Lib/IMPL/Object/Abstract.pm Tue Jun 08 03:38:10 2010 +0400 +++ b/Lib/IMPL/Object/Abstract.pm Tue Jun 08 20:12:45 2010 +0400 @@ -73,7 +73,7 @@ return (ref $self || $self); } -sub type { +sub typeof { ref $_[0] || $_[0]; } diff -r 92c850d0bdb9 -r a7efb3117295 Lib/IMPL/Web/TT/Control.pm --- a/Lib/IMPL/Web/TT/Control.pm Tue Jun 08 03:38:10 2010 +0400 +++ b/Lib/IMPL/Web/TT/Control.pm Tue Jun 08 20:12:45 2010 +0400 @@ -3,6 +3,7 @@ use base qw(IMPL::Web::TT::Collection); use IMPL::Class::Property; +use IMPL::DOM::Property qw(_dom); __PACKAGE__->PassThroughArgs; diff -r 92c850d0bdb9 -r a7efb3117295 Lib/IMPL/Web/TT/Form.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/TT/Form.pm Tue Jun 08 20:12:45 2010 +0400 @@ -0,0 +1,22 @@ +use strict; +package IMPL::Web::TT::Form; + +use base qw(IMPL::Web::TT::Control); + + +1; + +__END__ + +=pod + +=head1 NAME + +C - Форма с элементами + +=head1 DESCRIPTION + +Является элементом управления, тоесть для своего преобразования ипользует +шаблон + +=cut \ No newline at end of file diff -r 92c850d0bdb9 -r a7efb3117295 _test/Test/DOM/Node.pm --- a/_test/Test/DOM/Node.pm Tue Jun 08 03:38:10 2010 +0400 +++ b/_test/Test/DOM/Node.pm Tue Jun 08 20:12:45 2010 +0400 @@ -121,4 +121,11 @@ failed "property isComplex returned true for a simple node", $this->Root->firstChild->nodeName if $this->Root->firstChild->isComplex; }; +package Test::DOM::TypedNode; +use base qw(IMPL::DOM::Node); +use IMPL::Class::Property; +use IMPL::DOM::Property; + + + 1;