/[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.4 - (show annotations) (download)
Sat Jul 14 09:19:11 2007 UTC (17 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +124 -16 lines 
++ manakai/t/ChangeLog	14 Jul 2007 09:19:01 -0000
	* DOM-Node.t: Test data for new constants and attributes
	are added.

	* DOM-TypeInfo.t: Tests for constants are added.

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

++ manakai/lib/Message/DOM/ChangeLog	14 Jul 2007 09:17:51 -0000
	* AttributeDefinition.pm (node_value): Implemented.
	(create_attribute_definition): Implemented.

	* DOMConfiguration.pm (%{}, TIEHASH,
	get_parameter, set_parameter, can_set_parameter,
	EXISTS, DELETE, parameter_names, FETCH, STORE,
	FIRSTKEY, LASTKEY): Implemented.

	* DOMDocument.pm (____new): Set |error-handler| default.
	(get_elements_by_tag_name, get_elements_by_tag_name_ns): Implemented.

	* DOMElement.pm (get_elements_by_tag_name, get_elements_by_tag_name_ns):
	Implemented.

	* DOMException.pm: Error types for |DOMConfiguration|
	are added.

	* DOMStringList.pm (Message::DOM::DOMStringList::StaticList): New
	class.

	* DocumentType.pm (get_element_type_definition_node,
	get_general_entity_node, get_notation_node,
	set_element_type_definition_node, set_general_entity_node,
	set_notation_node, create_document_type_definition): Implemented.

	* ElementTypeDefinition.pm (get_attribute_definition_node,
	set_attribute_definition_node, create_element_type_definition):
	Implemented.

	* Entity.pm (create_general_entity): Implemented.

	* Node.pm: Constants in |OperationType| definition
	group are added.
	(manakai_language): Implemented.

	* NodeList.pm (Message::DOM::NodeList::GetElementsList): New
	class.

	* Notation.pm (create_notation): Implemented.

2007-07-14  Wakaba  <wakaba@suika.fam.cx>
1 package Message::DOM::DOMConfiguration;
2 use strict;
3 our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\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 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
34 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
35 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
36 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
37 );
38 ## http://suika.fam.cx/www/2006/dom-config/xml-id
39 ## xml-dtd
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 }->{$name}) {
57 return 1;
58 } elsif ($name eq 'error-handler') {
59 return 1 unless defined $_[2];
60 return ref $_[2] eq 'CODE';
61 } else {
62 return 0;
63 }
64 } # can_set_parameter
65
66 sub get_parameter ($$) {
67 my $name = ''.$_[1];
68 if ({
69 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
70 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
71 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
72 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
73 'error-handler' => 1,
74 }->{$name}) {
75 return ${$${$_[0]}}->{$name};
76 } else {
77 report Message::DOM::DOMException
78 -object => $_[0],
79 -type => 'NOT_FOUND_ERR',
80 -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
81 }
82 } # get_parameter
83 *FETCH = \&get_parameter;
84
85 ## TODO: Should we allow $cfg->{error_handler}?
86
87 sub set_parameter ($$;$) {
88 my $name = ''.$_[1];
89 if (defined $_[2]) {
90 if ({
91 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
92 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
93 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
94 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
95 }->{$name}) {
96 if ($_[2]) {
97 ${$${$_[0]}}->{$name} = 1;
98 } else {
99 delete ${$${$_[0]}}->{$name};
100 }
101 } elsif ($name eq 'error-handler') {
102 if (ref $_[2] eq 'CODE') {
103 ${$${$_[0]}}->{$name} = $_[2];
104 } else {
105 report Message::DOM::DOMException
106 -object => $_[0],
107 -type => 'TYPE_MISMATCH_ERR',
108 -subtype => 'CONFIGURATION_PARAMETER_TYPE_ERR';
109 }
110 } else {
111 report Message::DOM::DOMException
112 -object => $_[0],
113 -type => 'NOT_FOUND_ERR',
114 -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
115 }
116 } else {
117 if ({
118 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
119 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
120 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
121 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
122 }->{$name}) {
123 ${$${$_[0]}}->{$name} = 1;
124 } elsif ($_[1] eq 'error-handler') {
125 ${$${$_[0]}}->{$name} = sub ($) {
126 ## NOTE: Same as one set by |Document| constructor.
127 warn $_[0];
128 return $_[0]->severity != 3; # SEVERITY_FATAL_ERROR
129 };
130 } else {
131 report Message::DOM::DOMException
132 -object => $_[0],
133 -type => 'NOT_FOUND_ERR',
134 -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
135 }
136 }
137 return undef;
138 } # set_parameter
139 *STORE = \&set_parameter;
140
141 sub DELETE ($$) {
142 local $Error::Depth = $Error::Depth + 1;
143 $_[0]->set_parameter ($_[1] => undef);
144 } # DELETE
145
146 sub EXISTS ($$) { exists $names{$_[1]} }
147
148 sub FIRSTKEY ($) {
149 my $a = keys %names;
150 return each %names;
151 } # FIRSTKEY
152
153 sub NEXTKEY ($) {
154 return each %names;
155 } # NEXTKEY
156
157 package Message::IF::DOMConfiguration;
158
159 =head1 LICENSE
160
161 Copyright 2007 Wakaba <w@suika.fam.cx>
162
163 This program is free software; you can redistribute it and/or
164 modify it under the same terms as Perl itself.
165
166 =cut
167
168 1;
169 ## $Date: 2007/06/21 14:57:53 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24