/[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 - (hide 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 wakaba 1.1 package Message::DOM::DOMConfiguration;
2     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.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     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 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     }->{$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 wakaba 1.3 sub get_parameter ($$) {
67 wakaba 1.4 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 wakaba 1.3 } # get_parameter
83 wakaba 1.4 *FETCH = \&get_parameter;
84    
85     ## TODO: Should we allow $cfg->{error_handler}?
86 wakaba 1.3
87 wakaba 1.1 sub set_parameter ($$;$) {
88 wakaba 1.4 my $name = ''.$_[1];
89 wakaba 1.2 if (defined $_[2]) {
90 wakaba 1.4 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 wakaba 1.2 } else {
117 wakaba 1.4 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 wakaba 1.2 } elsif ($_[1] eq 'error-handler') {
125 wakaba 1.4 ${$${$_[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 wakaba 1.2 } else {
131 wakaba 1.4 report Message::DOM::DOMException
132     -object => $_[0],
133     -type => 'NOT_FOUND_ERR',
134     -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
135 wakaba 1.2 }
136     }
137 wakaba 1.4 return undef;
138 wakaba 1.1 } # set_parameter
139 wakaba 1.4 *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 wakaba 1.1
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 wakaba 1.4 ## $Date: 2007/06/21 14:57:53 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24