Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Улучшены тесты Исправлены ошибки Улучшена документация Работа над схемой DOM
author Sergey
date Mon, 24 Aug 2009 01:05:34 +0400
parents
children d660fb38b7cc
comparison
equal deleted inserted replaced
6:e2cd73ccc5bd 7:94d47b388442
1 package IMPL::DOM::Property;
2 use strict;
3 use warnings;
4
5 use IMPL::Class::Property;
6 require IMPL::Exception;
7
8 use base qw(Exporter);
9 our @EXPORT_OK = qw(_dom);
10
11 sub _dom($) {
12 my ($prop_info) = @_;
13 $prop_info->Implementor( 'IMPL::DOM::Property' );
14 return $prop_info;
15 }
16
17 sub Make {
18 my ($self,$propInfo) = @_;
19
20 my ($class,$name,$virt,$access,$mutators) = $propInfo->get qw(Class Name Virtual Access Mutators);
21
22 die new IMPL::InvalidOperationException("DOM properties can be declared only for the DOM objects") unless $class->isa('IMPL::DOM::Node');
23
24 no strict 'refs';
25 die new IMPL::InvalidOperationException("Custom mutators are not allowed","${class}::$name") if ref $mutators;
26 if (($mutators & prop_all) == prop_all) {
27 *{"${class}::$name"} = sub {
28 $_[0]->Property($name,@_[1..$#_]);
29 };
30 $propInfo->canGet(1);
31 $propInfo->canSet(1);
32 } elsif( $mutators & prop_get ) {
33 *{"${class}::$name"} = sub {
34 die new IMPL::InvalidOperationException("This is a readonly property", "${class}::$name") if @_>1;
35 $_[0]->Property($name);
36 };
37 $propInfo->canGet(1);
38 $propInfo->canSet(0);
39 } elsif( $mutators & prop_set ) {
40 *{"${class}::$name"} = sub {
41 die new IMPL::InvalidOperationException("This is a writeonly property", "${class}::$name") if @_<2;
42 $_[0]->Property($name,@_[1..$#_]);
43 };
44 $propInfo->canGet(0);
45 $propInfo->canSet(1);
46 } else {
47 die new IMPL::InvalidOperationException("Invalid value for the property mutators","${class}::$name",$mutators);
48 }
49 }
50
51 1;
52 __END__
53 =pod
54
55 =head1 SYNOPSIS
56
57 package TypedNode;
58
59 use base qw(IMPL::DOM::Node);
60 use IMPL::DOM::Property qw(_dom);
61
62 BEGIN {
63 public _dom property Age => prop_all;
64 public _dom property Address => prop_all;
65 public property ServiceData => prop_all;
66 }
67
68 =head1 DESCRIPTION
69
70 ,
71 .
72
73 =cut