changeset 122:a7efb3117295

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.
author wizard
date Tue, 08 Jun 2010 20:12:45 +0400
parents 92c850d0bdb9
children 1d7e370a91fa
files Lib/IMPL/DOM/Navigator.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/Property.pm Lib/IMPL/Object/Abstract.pm Lib/IMPL/Web/TT/Control.pm Lib/IMPL/Web/TT/Form.pm _test/Test/DOM/Node.pm
diffstat 7 files changed, 58 insertions(+), 58 deletions(-) [+]
line wrap: on
line diff
--- 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 {
--- 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};
 }
--- 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
--- 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];
 }
 
--- 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;
 
--- /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<IMPL::Web::TT::Form> - Форма с элементами
+
+=head1 DESCRIPTION
+
+Является элементом управления, тоесть для своего преобразования ипользует
+шаблон 
+
+=cut
\ No newline at end of file
--- 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;