/[suikacvs]/messaging/manakai/lib/Message/DOM/Entity.pm
Suika

Contents of /messaging/manakai/lib/Message/DOM/Entity.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations) (download)
Sun Jun 17 14:15:39 2007 UTC (17 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.4: +10 -2 lines
++ manakai/t/ChangeLog	17 Jun 2007 14:14:51 -0000
	* DOM-Node.t: |notation_name| test added.

	* DOM-Entity.t: |notation_name| test added.

2007-06-17  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	17 Jun 2007 14:13:48 -0000
	* AttributeDefinition.pm (____new): Set an empty list
	to the |allowed_tokens| attribute.
	(allowed_token): Alpha version.

	* DocumentType.pm (get_element_type_definition_node,
	get_notation_node): ALpha version.

	* ElementTypeDefinition.pm (attribute_definitions): Alpha 2
	version.

	* Entity.pm (notation_name): Implemented.

2007-06-17  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.2 package Message::DOM::Entity;
2 wakaba 1.1 use strict;
3 wakaba 1.5 our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 wakaba 1.2 push our @ISA, 'Message::DOM::Node', 'Message::IF::Entity';
5 wakaba 1.1 require Message::DOM::Node;
6    
7     sub ____new ($$$) {
8     my $self = shift->SUPER::____new (shift);
9     $$self->{node_name} = $_[0];
10 wakaba 1.3 $$self->{child_nodes} = [];
11 wakaba 1.1 return $self;
12     } # ____new
13    
14     sub AUTOLOAD {
15     my $method_name = our $AUTOLOAD;
16     $method_name =~ s/.*:://;
17     return if $method_name eq 'DESTROY';
18    
19     if ({
20     ## Read-only attributes (trivial accessors)
21 wakaba 1.2 node_name => 1,
22 wakaba 1.1 }->{$method_name}) {
23     no strict 'refs';
24     eval qq{
25     sub $method_name (\$) {
26     if (\@_ > 1) {
27     require Carp;
28     Carp::croak (qq<Can't modify read-only attribute>);
29     }
30     return \${\$_[0]}->{$method_name};
31     }
32     };
33     goto &{ $AUTOLOAD };
34     } elsif ({
35 wakaba 1.4 ## Read-write attributes (boolean, trivial accessors)
36     has_replacement_tree => 1,
37     }->{$method_name}) {
38     no strict 'refs';
39     eval qq{
40     sub $method_name (\$;\$) {
41     if (\@_ > 1) {
42     if (\${\${\$_[0]}->{owner_document}}->{manakai_strict_error_checking} and
43     \${\$_[0]}->{manakai_read_only}) {
44     report Message::DOM::DOMException
45     -object => \$_[0],
46     -type => 'NO_MODIFICATION_ALLOWED_ERR',
47     -subtype => 'READ_ONLY_NODE_ERR';
48     }
49     if (\$_[1]) {
50     \${\$_[0]}->{$method_name} = 1;
51     } else {
52     delete \${\$_[0]}->{$method_name};
53     }
54     }
55     return \${\$_[0]}->{$method_name};
56     }
57     };
58     goto &{ $AUTOLOAD };
59     } elsif ({
60 wakaba 1.1 ## Read-write attributes (DOMString, trivial accessors)
61 wakaba 1.5 notation_name => 1,
62 wakaba 1.1 public_id => 1,
63     system_id => 1,
64 wakaba 1.5 xml_encoding => 1,
65 wakaba 1.1 }->{$method_name}) {
66     no strict 'refs';
67     eval qq{
68 wakaba 1.4 sub $method_name (\$;\$) {
69 wakaba 1.1 if (\@_ > 1) {
70 wakaba 1.4 if (\${\$_[0]}->{strict_error_checking} and
71     \${\$_[0]}->{manakai_read_only}) {
72     report Message::DOM::DOMException
73     -object => \$_[0],
74     -type => 'NO_MODIFICATION_ALLOWED_ERR',
75     -subtype => 'READ_ONLY_NODE_ERR';
76     }
77     if (defined \$_[1]) {
78     \${\$_[0]}->{$method_name} = ''.\$_[1];
79     } else {
80     delete \${\$_[0]}->{$method_name};
81     }
82 wakaba 1.1 }
83 wakaba 1.4 return \${\$_[0]}->{$method_name};
84 wakaba 1.1 }
85     };
86     goto &{ $AUTOLOAD };
87     } else {
88     require Carp;
89     Carp::croak (qq<Can't locate method "$AUTOLOAD">);
90     }
91     } # AUTOLOAD
92    
93 wakaba 1.4 ## |Node| attributes
94    
95     sub node_name ($); # read-only trivial accessor
96    
97     sub node_type () { 6 } # ENTITY_NODE
98    
99     ## |Entity| attributes
100    
101     sub manakai_declaration_base_uri ($;$) {
102     ## NOTE: Same as |Notation|'s.
103    
104     if (@_ > 1) {
105     if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
106     ${$_[0]}->{manakai_read_only}) {
107     report Message::DOM::DOMException
108     -object => $_[0],
109     -type => 'NO_MODIFICATION_ALLOWED_ERR',
110     -subtype => 'READ_ONLY_NODE_ERR';
111     }
112     if (defined $_[1]) {
113     ${$_[0]}->{manakai_declaration_base_uri} = ''.$_[1];
114     } else {
115     delete ${$_[0]}->{manakai_declaration_base_uri};
116     }
117     }
118    
119     if (defined wantarray) {
120     if (defined ${$_[0]}->{manakai_declaration_base_uri}) {
121     return ${$_[0]}->{manakai_declaration_base_uri};
122     } else {
123     local $Error::Depth = $Error::Depth + 1;
124     return $_[0]->base_uri;
125     }
126     }
127     } # manakai_declaration_base_uri
128    
129     sub manakai_entity_base_uri ($;$) {
130     my $self = $_[0];
131     if (@_ > 1) {
132     if (${$$self->{owner_document}}->{strict_error_checking}) {
133     if ($$self->{manakai_read_only}) {
134     report Message::DOM::DOMException
135     -object => $self,
136     -type => 'NO_MODIFICATION_ALLOWED_ERR',
137     -subtype => 'READ_ONLY_NODE_ERR';
138     }
139     }
140     if (defined $_[1]) {
141     $$self->{manakai_entity_base_uri} = ''.$_[1];
142     } else {
143     delete $$self->{manakai_entity_base_uri};
144     }
145     }
146    
147     if (defined wantarray) {
148     if (defined $$self->{manakai_entity_base_uri}) {
149     return $$self->{manakai_entity_base_uri};
150     } else {
151     local $Error::Depth = $Error::Depth + 1;
152     my $v = $self->manakai_entity_uri;
153     return $v if defined $v;
154     return $self->base_uri;
155     }
156     }
157     } # manakai_entity_base_uri
158    
159     sub manakai_entity_uri ($;$) {
160     my $self = $_[0];
161     if (@_ > 1) {
162     if (${$$self->{owner_document}}->{strict_error_checking}) {
163     if ($$self->{manakai_read_only}) {
164     report Message::DOM::DOMException
165     -object => $self,
166     -type => 'NO_MODIFICATION_ALLOWED_ERR',
167     -subtype => 'READ_ONLY_NODE_ERR';
168     }
169     }
170     if (defined $_[1]) {
171     $$self->{manakai_entity_uri} = ''.$_[1];
172     } else {
173     delete $$self->{manakai_entity_uri};
174     }
175     }
176 wakaba 1.1
177 wakaba 1.4 if (defined wantarray) {
178     return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};
179 wakaba 1.2
180 wakaba 1.4 local $Error::Depth = $Error::Depth + 1;
181     my $v = $$self->{system_id};
182     if (defined $v) {
183     $v = ${$$self->{owner_document}}->{implementation}->create_uri_reference
184     ($v);
185     if (not defined $v->uri_scheme) {
186     my $base = $self->manakai_declaration_base_uri;
187     return $v->get_absolute_reference ($base)->uri_reference
188     if defined $base;
189     }
190     return $v->uri_reference;
191     } else {
192     return undef;
193     }
194     }
195     } # manakai_entity_uri
196    
197     ## NOTE: Setter is a manakai extension.
198 wakaba 1.5 sub notation_name ($;$);
199    
200     ## NOTE: Setter is a manakai extension.
201 wakaba 1.4 sub public_id ($;$);
202    
203     ## NOTE: Setter is a manakai extension.
204     sub system_id ($;$);
205 wakaba 1.2
206 wakaba 1.5 ## NOTE: Setter is a manakai extension.
207     sub xml_encoding ($;$);
208    
209 wakaba 1.4 ## |Entity| methods
210 wakaba 1.2
211 wakaba 1.4 ## NOTE: A manakai extension
212     sub has_replacement_tree ($;$);
213 wakaba 1.1
214     package Message::IF::Entity;
215    
216     package Message::DOM::Document;
217    
218 wakaba 1.2 sub create_general_entity ($$) {
219 wakaba 1.1 return Message::DOM::Entity->____new (@_[0, 1]);
220     } # create_general_entity
221    
222 wakaba 1.4 =head1 LICENSE
223    
224     Copyright 2007 Wakaba <w@suika.fam.cx>
225    
226     This program is free software; you can redistribute it and/or
227     modify it under the same terms as Perl itself.
228    
229     =cut
230    
231 wakaba 1.1 1;
232 wakaba 1.5 ## $Date: 2007/06/17 13:37:40 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24