diff Lib/IMPL/DOM/Property.pm @ 7:94d47b388442

Улучшены тесты Исправлены ошибки Улучшена документация Работа над схемой DOM
author Sergey
date Mon, 24 Aug 2009 01:05:34 +0400
parents
children d660fb38b7cc
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Property.pm	Mon Aug 24 01:05:34 2009 +0400
@@ -0,0 +1,73 @@
+package IMPL::DOM::Property;
+use strict;
+use warnings;
+
+use IMPL::Class::Property;
+require IMPL::Exception;
+
+use base qw(Exporter);
+our @EXPORT_OK = qw(_dom);
+
+sub _dom($) {
+    my ($prop_info) = @_;
+    $prop_info->Implementor( 'IMPL::DOM::Property' );
+    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]->Property($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]->Property($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]->Property($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
+
+=head1 SYNOPSIS
+
+package TypedNode;
+
+use base qw(IMPL::DOM::Node);
+use IMPL::DOM::Property qw(_dom);
+
+BEGIN {
+    public _dom property Age => prop_all;
+    public _dom property Address => prop_all;
+    public property ServiceData => prop_all;
+}
+
+=head1 DESCRIPTION
+
+  ,      
+.
+
+=cut
\ No newline at end of file