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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations) (download)
Sun Jul 8 05:42:36 2007 UTC (19 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.7: +11 -2 lines
++ manakai/t/ChangeLog	8 Jul 2007 05:42:31 -0000
2007-07-08  Wakaba  <wakaba@suika.fam.cx>

	* DOM-Document.t, DOM-Node.t, DOM-NodeList.t: Some tests are modified so
	that no |WRONG_DOCUMENT_ERR| is raised.

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

++ manakai/lib/Message/DOM/ChangeLog	8 Jul 2007 05:41:27 -0000
2007-07-08  Wakaba  <wakaba@suika.fam.cx>

	* Attr.pm, AttributeDefinition.pm, DOMCharacterData.pm,
	DOMDocument.pm, DocumentType.pm, ElementTypeDefinition.pm,
	Node.pm, Notation.pm, ProcessingInstruction.pm (append_child,
	insert_before, replace_child): Implemented.

	* DOMException.pm (HIERARCHY_REQUEST_ERR, NOT_FOUND_ERR): Implemented.

	* Node.pm (remove_child): Implemented.

1 package Message::DOM::AttributeDefinition;
2 use strict;
3 our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 push our @ISA, 'Message::DOM::Node', 'Message::IF::AttributeDefinition';
5 require Message::DOM::Node;
6 require Message::DOM::Attr;
7
8 sub ____new ($$$) {
9 my $self = shift->SUPER::____new (shift);
10 $$self->{node_name} = $_[0];
11 $$self->{child_nodes} = [];
12 $$self->{allowed_tokens} = [];
13 return $self;
14 } # ____new
15
16 sub AUTOLOAD {
17 my $method_name = our $AUTOLOAD;
18 $method_name =~ s/.*:://;
19 return if $method_name eq 'DESTROY';
20
21 if ({
22 ## Read-only attributes (trivial accessors)
23 node_name => 1,
24 }->{$method_name}) {
25 no strict 'refs';
26 eval qq{
27 sub $method_name (\$) {
28 if (\@_ > 1) {
29 require Carp;
30 Carp::croak (qq<Can't modify read-only attribute>);
31 }
32 return \${\$_[0]}->{$method_name};
33 }
34 };
35 goto &{ $AUTOLOAD };
36 } elsif ({
37 ## Read-write attributes (DOMString, trivial accessors)
38 }->{$method_name}) {
39 no strict 'refs';
40 eval qq{
41 sub $method_name (\$) {
42 if (\@_ > 1) {
43 \${\$_[0]}->{$method_name} = ''.$_[1];
44 }
45 return \${\$_[0]}->{$method_name};
46 }
47 };
48 goto &{ $AUTOLOAD };
49 } else {
50 require Carp;
51 Carp::croak (qq<Can't locate method "$AUTOLOAD">);
52 }
53 } # AUTOLOAD
54
55 ## |AttributeDefinition| constants
56
57 ## |DeclaredValueType|
58 sub NO_TYPE_ATTR () { 0 }
59 sub CDATA_ATTR () { 1 }
60 sub ID_ATTR () { 2 }
61 sub IDREF_ATTR () { 3 }
62 sub IDREFS_ATTR () { 4 }
63 sub ENTITY_ATTR () { 5 }
64 sub ENTITIES_ATTR () { 6 }
65 sub NMTOKEN_ATTR () { 7 }
66 sub NMTOKENS_ATTR () { 8 }
67 sub NOTATION_ATTR () { 9 }
68 sub ENUMERATION_ATTR () { 10 }
69 sub UNKNOWN_ATTR () { 11 }
70
71 ## |DefaultValueType|
72 sub UNKNOWN_DEFAULT () { 0 }
73 sub FIXED_DEFAULT () { 1 }
74 sub REQUIRED_DEFAULT () { 2 }
75 sub IMPLIED_DEFAULT () { 3 }
76 sub EXPLICIT_DEFAULT () { 4 }
77
78 ## The |Node| interface - attribute
79
80 ## Spec:
81 ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-F68D095>
82 ## <http://suika.fam.cx/gate/2005/sw/AttributeDefinition>
83
84 sub node_name ($); # read-only trivial accessor
85
86 ## Spec:
87 ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-111237558>
88
89 sub node_type ($) { 81002 } # ATTRIBUTE_DEFINITION_NODE
90
91 ## Spec:
92 ## <http://suika.fam.cx/gate/2005/sw/AttributeDefinition#anchor-2>
93
94 ## TODO: node_value
95
96 ## |Node| methods
97
98 *append_child = \&Message::DOM::Attr::append_child;
99
100 *insert_before = \&Message::DOM::Attr::insert_before;
101
102 *replace_child = \&Message::DOM::Attr::replace_child;
103
104 ## |AttributeDefinition| attributes
105
106 sub allowed_tokens ($) {
107 require Message::DOM::DOMStringList;
108 return bless \[$_[0], 'allowed_tokens'], 'Message::DOM::DOMStringList';
109 } # allowed_tokens
110
111 sub declared_type ($;$) {
112 my $self = $_[0];
113 if (@_ > 1) {
114 if (${$$self->{owner_document}}->{strict_error_checking}) {
115 if ($$self->{manakai_read_only}) {
116 report Message::DOM::DOMException
117 -object => $self,
118 -type => 'NO_MODIFICATION_ALLOWED_ERR',
119 -subtype => 'READ_ONLY_NODE_ERR';
120 }
121 }
122 if ($_[1]) {
123 $$self->{declared_type} = 0+$_[1];
124 } else {
125 delete $$self->{declared_type};
126 }
127 }
128
129 return $$self->{declared_type} || 0;
130 } # declared_type
131
132 sub default_type ($;$) {
133 my $self = $_[0];
134 if (@_ > 1) {
135 if (${$$self->{owner_document}}->{strict_error_checking}) {
136 if ($$self->{manakai_read_only}) {
137 report Message::DOM::DOMException
138 -object => $self,
139 -type => 'NO_MODIFICATION_ALLOWED_ERR',
140 -subtype => 'READ_ONLY_NODE_ERR';
141 }
142 }
143 if ($_[1]) {
144 $$self->{default_type} = 0+$_[1];
145 } else {
146 delete $$self->{default_type};
147 }
148 }
149
150 return $$self->{default_type} || 0;
151 } # default_type
152
153 package Message::IF::AttributeDefinition;
154
155 package Message::DOM::Document;
156
157 ## Spec:
158 ## <http://suika.fam.cx/gate/2005/sw/DocumentXDoctype>
159
160 sub create_attribute_definition ($$) {
161 return Message::DOM::AttributeDefinition->____new (@_[0, 1]);
162 } # create_attribute_definition
163
164 1;
165 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
166 ## $Date: 2007/07/07 04:47:29 $

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24