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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.6 - (show annotations) (download)
Sat Jul 14 16:32:28 2007 UTC (17 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.5: +15 -4 lines 
++ manakai/t/ChangeLog	14 Jul 2007 16:32:13 -0000
2007-07-15  Wakaba  <wakaba@suika.fam.cx>

	* DOM-TreeWalker.t, DOM-SerialWalker.t: New test scripts.

	* DOM-DOMImplementation.t: Tests for |Traversal| feature
	are added.

	* DOM-Node.t: Tests for |Traversal| feature are added.

++ manakai/lib/Message/DOM/ChangeLog	14 Jul 2007 16:31:23 -0000
2007-07-15  Wakaba  <wakaba@suika.fam.cx>

	* TreeWalker.pm, SerialWalker.pm: New Perl modules.

	* Text.pm (whole_text): Parameter index number has
	been changed to support new |NodeFilter| Perl binding
	definition.

2007-07-14  Wakaba  <wakaba@suika.fam.cx>

	* AttributeDefinition.pm, DOMElement.pm, DocumentType.pm,
	ElementTypeDefinition.pm, Entity.pm, EntityReference.pm,
	Notation.pm, ProcessingInstruction.pm (AUTOLOAD): Don't croak even if an attempt is made to modify a read-only attribute.

	* DOMConfiguration.pm (can_set_parameter,
	set_parameter): Don't allow to set the value
	to a string other than <http://www.w3.org/TR/REC-xml> (XML 1.0 DTD).

	* DOMDocument.pm (Message::IF::DocumentTraversal): New interface.
	(create_tree_walker, manakai_create_serial_walker): References
	and prototypes are added.

	* DOMException.pm (NULLPO_ERR): New error type:-).

	* DOMImplementation.pm ($HasFeature): Feature |Traversal|,
	version |2.0|, is added.
1 package Message::DOM::DOMConfiguration;
2 use strict;
3 our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 push our @ISA, 'Message::IF::DOMConfiguration';
5 require Message::DOM::DOMException;
6
7 use overload
8 '%{}' => sub {
9 tie my %list, ref $_[0], $_[0];
10 return \%list;
11 },
12 eq => sub {
13 return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::DOMConfiguration');
14 return $${$_[0]} eq $${$_[1]};
15 },
16 ne => sub {
17 return not ($_[0] eq $_[1]);
18 },
19 fallback => 1;
20
21 sub ___report_error ($$) {
22 $_[1]->throw;
23 } # ___report_error
24
25 sub TIEHASH ($$) { $_[1] }
26
27 ## TODO: Define Perl binding
28
29 ## |DOMConfiguration| attribute
30
31 my %names = (
32 'error-handler' => 1,
33 'schema-type' => 1,
34 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
35 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
36 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
37 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
38 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
39 );
40
41 sub parameter_names ($) {
42 require Message::DOM::DOMStringList;
43 return bless [sort {$a cmp $b} keys %names],
44 'Message::DOM::DOMStringList::StaticList';
45 } # parameter_names
46
47 ## |DOMConfiguration| methods
48
49 sub can_set_parameter ($$;$) {
50 my $name = ''.$_[1];
51 if ({
52 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
53 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
54 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
55 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
56 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
57 }->{$name}) {
58 return 1;
59 } elsif ($name eq 'error-handler') {
60 return 1 unless defined $_[2];
61 return ref $_[2] eq 'CODE';
62 } elsif ($name eq 'schema-type') {
63 return 1 unless defined $_[2];
64 return 1 if ''.$_[2] eq q<http://www.w3.org/TR/REC-xml>;
65 return 0;
66 } else {
67 return 0;
68 }
69 } # can_set_parameter
70
71 sub get_parameter ($$) {
72 my $name = ''.$_[1];
73 if ({
74 'schema-type' => 1,
75 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
76 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
77 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
78 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
79 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
80 'error-handler' => 1,
81 }->{$name}) {
82 return ${$${$_[0]}}->{$name};
83 } else {
84 report Message::DOM::DOMException
85 -object => $_[0],
86 -type => 'NOT_FOUND_ERR',
87 -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
88 }
89 } # get_parameter
90 *FETCH = \&get_parameter;
91
92 ## TODO: Should we allow $cfg->{error_handler}?
93
94 sub set_parameter ($$;$) {
95 my $name = ''.$_[1];
96 if (defined $_[2]) {
97 if ({
98 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
99 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
100 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
101 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
102 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
103 }->{$name}) {
104 if ($_[2]) {
105 ${$${$_[0]}}->{$name} = 1;
106 } else {
107 delete ${$${$_[0]}}->{$name};
108 }
109 } elsif ($name eq 'error-handler') {
110 if (ref $_[2] eq 'CODE') {
111 ${$${$_[0]}}->{$name} = $_[2];
112 } else {
113 report Message::DOM::DOMException
114 -object => $_[0],
115 -type => 'TYPE_MISMATCH_ERR',
116 -subtype => 'CONFIGURATION_PARAMETER_TYPE_ERR';
117 }
118 } elsif ($name eq 'schema-type') {
119 my $value = ''.$_[2];
120 if ($value eq q<http://www.w3.org/TR/REC-xml>) {
121 ${$${$_[0]}}->{$name} = ''.$_[2];
122 } else {
123 report Message::DOM::DOMException
124 -object => $_[0],
125 -type => 'NOT_SUPPORTED_ERR',
126 -subtype => 'CONFIGURATION_PARAMETER_VALUE_ERR';
127 }
128 } else {
129 report Message::DOM::DOMException
130 -object => $_[0],
131 -type => 'NOT_FOUND_ERR',
132 -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
133 }
134 } else { # reset
135 if ({
136 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
137 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
138 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
139 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
140 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
141 }->{$name}) {
142 ${$${$_[0]}}->{$name} = 1;
143 } elsif ({
144 'schema-type' => 1,
145 }->{$name}) {
146 delete ${$${$_[0]}}->{$name};
147 } elsif ($_[1] eq 'error-handler') {
148 ${$${$_[0]}}->{$name} = sub ($) {
149 ## NOTE: Same as one set by |Document| constructor.
150 warn $_[0];
151 return $_[0]->severity != 3; # SEVERITY_FATAL_ERROR
152 };
153 } else {
154 report Message::DOM::DOMException
155 -object => $_[0],
156 -type => 'NOT_FOUND_ERR',
157 -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
158 }
159 }
160 return undef;
161 } # set_parameter
162 *STORE = \&set_parameter;
163
164 sub DELETE ($$) {
165 local $Error::Depth = $Error::Depth + 1;
166 $_[0]->set_parameter ($_[1] => undef);
167 } # DELETE
168
169 sub EXISTS ($$) { exists $names{$_[1]} }
170
171 sub FIRSTKEY ($) {
172 my $a = keys %names;
173 return each %names;
174 } # FIRSTKEY
175
176 sub NEXTKEY ($) {
177 return each %names;
178 } # NEXTKEY
179
180 package Message::IF::DOMConfiguration;
181
182 =head1 LICENSE
183
184 Copyright 2007 Wakaba <w@suika.fam.cx>
185
186 This program is free software; you can redistribute it and/or
187 modify it under the same terms as Perl itself.
188
189 =cut
190
191 1;
192 ## $Date: 2007/07/14 10:00:32 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24