/[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.4 - (hide annotations) (download)
Sun Jun 17 13:37:40 2007 UTC (17 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +160 -23 lines
++ manakai/t/ChangeLog	17 Jun 2007 13:37:22 -0000
2007-06-17  Wakaba  <wakaba@suika.fam.cx>

	* DOM-Attr.t, DOM-AttributeDefinition.t, DOM-DocumentType.t,
	DOM-Element.t, DOM-Entity.t, DOM-EntityReference.t,
	DOM-Notation.t, DOM-ProcessingInstruction.t: New.

	* DOM-Document.t, DOM-Node.t: Tests for newly-implemented attributes
	and methods are added.

	* Makefile (test-module-dom-old): Renamed from |test-module-dom|.
	(test-module-dom): New.

++ manakai/lib/Message/DOM/ChangeLog	17 Jun 2007 13:34:54 -0000
2007-06-17  Wakaba  <wakaba@suika.fam.cx>

	* Attr.pm (____new): Initialize |specified| as 1.
	(base_uri, manakai_attribute_type, specified): Implemented.
	(prefix): Don't check read-only flag unless |strict_error_checking|.
	(value): Call |text_content| for now.

	* AttributeDefinition.pm (DeclaredValueType, DefaultValueType): Added.
	(declared_type, default_type): Implemented.

	* CharacterData.pm (____new): Allow a scalar reference
	as an input for the |data| attribute.
	(base_uri, manakai_append_text): Implemented.

	* DOMConfiguration.pm (set_parameter): Resetting implemented.

	* DOMDocument.pm (____new): Set default values to
	configuration parameter whose default is true.
	(document_uri, input_encoding): Implemented.
	(all_declarations_processed, manakai_is_html): Implemented.
	(base_uri, manakai_append_text,
	manakai_entity_base_uri, strict_error_checking,
	xml_encoding, xml_version, xml_standalone): Implemented.

	* DOMElement.pm (manakai_base_uri, base_uri): Implemented.
	(get_attribute, get_attribute_node): Alpha version.
	(set_attribute_node, set_attribute_node_ns): Implemented.
	(set_attribute_ns): Accept non-ARRAY qualified name.

	* DOMException.pm (___error_def): |WRONG_DOCUMENT_ERR|,
	|NOT_SUPPORTED_ERR|, and |INUSE_ATTRIBUTE_ERR| are added.

	* DocumentType.pm (public_id, system_id): Implemented.
	(base_uri, declaration_base_uri, manakai_declaration_base_uri,
	manakai_append_text): Implemented.
	(element_types, general_entities, notations,
	set_element_type_definition_node, set_general_entity_node,
	set_notation_node): Alpha version.

	* ElementTypeDefinition.pm (manakai_append_text): Implemented.
	(attribute_definitions, set_attribute_definition_node): Alpha version.

	* Entity.pm (has_replacement_tree, public_id, system_id,
	manakai_declaration_base_uri, manakai_entity_base_uri,
	manakai_entity_uri): Implemented.

	* EntityReference.pm (manakai_expanded, manakai_external): Implemented.
	(base_uri, manakai_entity_base_uri): Implemented.

	* Node.pm (base_uri): Implemented.
	(text_content): Don't check read-only or not
	unless |strict_error_checking|.
	(manakai_append_text): Implemented.
	(get_feature): Alpha.
	(manakai_set_read_only): Implemented.

	* Notation.pm (public_id, system_id, manakai_append_text,
	manakai_declaration_base_uri): Implemented.

	* ProcessingInstruction.pm (manakai_base_uri,
	base_uri, manakai_append_text): Implemented.

1 wakaba 1.2 package Message::DOM::Entity;
2 wakaba 1.1 use strict;
3 wakaba 1.4 our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\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     public_id => 1,
62     system_id => 1,
63     }->{$method_name}) {
64     no strict 'refs';
65     eval qq{
66 wakaba 1.4 sub $method_name (\$;\$) {
67 wakaba 1.1 if (\@_ > 1) {
68 wakaba 1.4 if (\${\$_[0]}->{strict_error_checking} and
69     \${\$_[0]}->{manakai_read_only}) {
70     report Message::DOM::DOMException
71     -object => \$_[0],
72     -type => 'NO_MODIFICATION_ALLOWED_ERR',
73     -subtype => 'READ_ONLY_NODE_ERR';
74     }
75     if (defined \$_[1]) {
76     \${\$_[0]}->{$method_name} = ''.\$_[1];
77     } else {
78     delete \${\$_[0]}->{$method_name};
79     }
80 wakaba 1.1 }
81 wakaba 1.4 return \${\$_[0]}->{$method_name};
82 wakaba 1.1 }
83     };
84     goto &{ $AUTOLOAD };
85     } else {
86     require Carp;
87     Carp::croak (qq<Can't locate method "$AUTOLOAD">);
88     }
89     } # AUTOLOAD
90    
91 wakaba 1.4 ## |Node| attributes
92    
93     sub node_name ($); # read-only trivial accessor
94    
95     sub node_type () { 6 } # ENTITY_NODE
96    
97     ## |Entity| attributes
98    
99     sub manakai_declaration_base_uri ($;$) {
100     ## NOTE: Same as |Notation|'s.
101    
102     if (@_ > 1) {
103     if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
104     ${$_[0]}->{manakai_read_only}) {
105     report Message::DOM::DOMException
106     -object => $_[0],
107     -type => 'NO_MODIFICATION_ALLOWED_ERR',
108     -subtype => 'READ_ONLY_NODE_ERR';
109     }
110     if (defined $_[1]) {
111     ${$_[0]}->{manakai_declaration_base_uri} = ''.$_[1];
112     } else {
113     delete ${$_[0]}->{manakai_declaration_base_uri};
114     }
115     }
116    
117     if (defined wantarray) {
118     if (defined ${$_[0]}->{manakai_declaration_base_uri}) {
119     return ${$_[0]}->{manakai_declaration_base_uri};
120     } else {
121     local $Error::Depth = $Error::Depth + 1;
122     return $_[0]->base_uri;
123     }
124     }
125     } # manakai_declaration_base_uri
126    
127     sub manakai_entity_base_uri ($;$) {
128     my $self = $_[0];
129     if (@_ > 1) {
130     if (${$$self->{owner_document}}->{strict_error_checking}) {
131     if ($$self->{manakai_read_only}) {
132     report Message::DOM::DOMException
133     -object => $self,
134     -type => 'NO_MODIFICATION_ALLOWED_ERR',
135     -subtype => 'READ_ONLY_NODE_ERR';
136     }
137     }
138     if (defined $_[1]) {
139     $$self->{manakai_entity_base_uri} = ''.$_[1];
140     } else {
141     delete $$self->{manakai_entity_base_uri};
142     }
143     }
144    
145     if (defined wantarray) {
146     if (defined $$self->{manakai_entity_base_uri}) {
147     return $$self->{manakai_entity_base_uri};
148     } else {
149     local $Error::Depth = $Error::Depth + 1;
150     my $v = $self->manakai_entity_uri;
151     return $v if defined $v;
152     return $self->base_uri;
153     }
154     }
155     } # manakai_entity_base_uri
156    
157     sub manakai_entity_uri ($;$) {
158     my $self = $_[0];
159     if (@_ > 1) {
160     if (${$$self->{owner_document}}->{strict_error_checking}) {
161     if ($$self->{manakai_read_only}) {
162     report Message::DOM::DOMException
163     -object => $self,
164     -type => 'NO_MODIFICATION_ALLOWED_ERR',
165     -subtype => 'READ_ONLY_NODE_ERR';
166     }
167     }
168     if (defined $_[1]) {
169     $$self->{manakai_entity_uri} = ''.$_[1];
170     } else {
171     delete $$self->{manakai_entity_uri};
172     }
173     }
174 wakaba 1.1
175 wakaba 1.4 if (defined wantarray) {
176     return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};
177 wakaba 1.2
178 wakaba 1.4 local $Error::Depth = $Error::Depth + 1;
179     my $v = $$self->{system_id};
180     if (defined $v) {
181     $v = ${$$self->{owner_document}}->{implementation}->create_uri_reference
182     ($v);
183     if (not defined $v->uri_scheme) {
184     my $base = $self->manakai_declaration_base_uri;
185     return $v->get_absolute_reference ($base)->uri_reference
186     if defined $base;
187     }
188     return $v->uri_reference;
189     } else {
190     return undef;
191     }
192     }
193     } # manakai_entity_uri
194    
195     ## NOTE: Setter is a manakai extension.
196     sub public_id ($;$);
197    
198     ## NOTE: Setter is a manakai extension.
199     sub system_id ($;$);
200 wakaba 1.2
201 wakaba 1.4 ## |Entity| methods
202 wakaba 1.2
203 wakaba 1.4 ## NOTE: A manakai extension
204     sub has_replacement_tree ($;$);
205 wakaba 1.1
206     package Message::IF::Entity;
207    
208     package Message::DOM::Document;
209    
210 wakaba 1.2 sub create_general_entity ($$) {
211 wakaba 1.1 return Message::DOM::Entity->____new (@_[0, 1]);
212     } # create_general_entity
213    
214 wakaba 1.4 =head1 LICENSE
215    
216     Copyright 2007 Wakaba <w@suika.fam.cx>
217    
218     This program is free software; you can redistribute it and/or
219     modify it under the same terms as Perl itself.
220    
221     =cut
222    
223 wakaba 1.1 1;
224 wakaba 1.4 ## $Date: 2007/06/16 15:27:45 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24