/[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 - (hide 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 wakaba 1.1 package Message::DOM::DOMConfiguration;
2     use strict;
3 wakaba 1.6 our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 wakaba 1.1 push our @ISA, 'Message::IF::DOMConfiguration';
5     require Message::DOM::DOMException;
6    
7     use overload
8 wakaba 1.4 '%{}' => sub {
9     tie my %list, ref $_[0], $_[0];
10     return \%list;
11     },
12 wakaba 1.1 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 wakaba 1.4 sub TIEHASH ($$) { $_[1] }
26    
27     ## TODO: Define Perl binding
28    
29     ## |DOMConfiguration| attribute
30    
31     my %names = (
32     'error-handler' => 1,
33 wakaba 1.5 'schema-type' => 1,
34 wakaba 1.4 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 wakaba 1.5 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
39 wakaba 1.4 );
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 wakaba 1.1 ## |DOMConfiguration| methods
48    
49 wakaba 1.4 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 wakaba 1.5 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
57 wakaba 1.4 }->{$name}) {
58     return 1;
59     } elsif ($name eq 'error-handler') {
60     return 1 unless defined $_[2];
61     return ref $_[2] eq 'CODE';
62 wakaba 1.6 } 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 wakaba 1.4 } else {
67     return 0;
68     }
69     } # can_set_parameter
70    
71 wakaba 1.3 sub get_parameter ($$) {
72 wakaba 1.4 my $name = ''.$_[1];
73     if ({
74 wakaba 1.5 'schema-type' => 1,
75 wakaba 1.4 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 wakaba 1.5 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
80 wakaba 1.4 '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 wakaba 1.3 } # get_parameter
90 wakaba 1.4 *FETCH = \&get_parameter;
91    
92     ## TODO: Should we allow $cfg->{error_handler}?
93 wakaba 1.3
94 wakaba 1.1 sub set_parameter ($$;$) {
95 wakaba 1.4 my $name = ''.$_[1];
96 wakaba 1.2 if (defined $_[2]) {
97 wakaba 1.4 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 wakaba 1.5 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
103 wakaba 1.4 }->{$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 wakaba 1.5 } elsif ($name eq 'schema-type') {
119 wakaba 1.6 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 wakaba 1.4 } else {
129     report Message::DOM::DOMException
130     -object => $_[0],
131     -type => 'NOT_FOUND_ERR',
132     -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
133     }
134 wakaba 1.5 } else { # reset
135 wakaba 1.4 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 wakaba 1.5 q<http://suika.fam.cx/www/2006/dom-config/xml-id> => 1,
141 wakaba 1.4 }->{$name}) {
142     ${$${$_[0]}}->{$name} = 1;
143 wakaba 1.5 } elsif ({
144     'schema-type' => 1,
145     }->{$name}) {
146     delete ${$${$_[0]}}->{$name};
147 wakaba 1.2 } elsif ($_[1] eq 'error-handler') {
148 wakaba 1.4 ${$${$_[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 wakaba 1.2 } else {
154 wakaba 1.4 report Message::DOM::DOMException
155     -object => $_[0],
156     -type => 'NOT_FOUND_ERR',
157     -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
158 wakaba 1.2 }
159     }
160 wakaba 1.4 return undef;
161 wakaba 1.1 } # set_parameter
162 wakaba 1.4 *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 wakaba 1.1
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 wakaba 1.6 ## $Date: 2007/07/14 10:00:32 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24