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

Contents of /messaging/manakai/lib/Message/DOM/Atom/AtomElement.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.3 - (hide annotations) (download)
Sun Jul 15 12:54:06 2007 UTC (19 years ago) by wakaba
Branch: MAIN
Changes since 1.2: +35 -34 lines 
++ manakai/t/ChangeLog	15 Jul 2007 07:03:38 -0000
	* DOM-Atom-AtomElement.t: New test script.

	* DOM-DOMImplementation.t, DOM-Node.t: New test
	data for |get_feature|.

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

++ manakai/lib/Message/Markup/ChangeLog	15 Jul 2007 07:53:30 -0000
2007-07-15  Wakaba  <wakaba@suika.fam.cx>

	* H2H.dis: A typo in entity name is fixed.

++ manakai/lib/Message/DOM/Atom/ChangeLog	15 Jul 2007 07:55:46 -0000
	* AtomElement.pm: Wrong module was loaded.
	(AUTOLOAD): No warnings!  Some argument index were incorrect.
	Some variables were not referenced correctly.
	(AtomDateConstruct): Package name was incorrect.

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

++ manakai/lib/Message/DOM/ChangeLog	15 Jul 2007 12:53:16 -0000
	* XMLParserTemp.pm: Use |Whatpm::Charset::DecodeHandle|
	instead of |Message::Charset::Encode|.

2007-07-15  Wakaba  <wakaba@suika.fam.cx>
1 wakaba 1.1 package Message::DOM::Atom::AtomElement;
2     use strict;
3 wakaba 1.3 our $VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 wakaba 1.1 push our @ISA, 'Message::DOM::Element';
5 wakaba 1.3 require Message::DOM::DOMElement;
6 wakaba 1.1
7     my $ATOM_NS = q<http://www.w3.org/2005/Atom>;
8     my $CREATE_CHILD_URI = q<http://suika.fam.cx/www/2006/dom-config/create-child-element>;
9 wakaba 1.3
10 wakaba 1.1 sub AUTOLOAD {
11     my $method_name = our $AUTOLOAD;
12     return if $method_name =~ /::DESTROY$/;
13    
14 wakaba 1.3 my $ln;
15     if ($ln = { ## Reflecting the string value of a content attribute
16 wakaba 1.1 'Message::DOM::Atom::AtomElement::AtomCategoryElement::label' => 'label',
17     'Message::DOM::Atom::AtomElement::AtomCategoryElement::term' => 'term',
18     'Message::DOM::Atom::AtomElement::AtomGeneratorElement::version' => 'version',
19     'Message::DOM::Atom::AtomElement::AtomLinkElement::hreflang' => 'hreflang',
20     'Message::DOM::Atom::AtomElement::AtomLinkElement::title' => 'title',
21     'Message::DOM::Atom::AtomElement::AtomLinkElement::length' => 'length',
22     }->{$method_name}) {
23     no strict 'refs';
24     eval qq{
25     sub $method_name (\$;\$) {
26     local \$Error::Depth = \$Error::Depth + 1;
27    
28     if (\@_ > 1) {
29     if (defined \$_[1]) {
30     \$_[0]->set_attribute_ns (undef, '$ln', ''.\$_[1]);
31     } else {
32     \$_[0]->remove_attribute_ns (undef, '$ln');
33     }
34     return unless defined wantarray;
35     }
36    
37     return \$_[0]->get_attribute_ns (undef, '$ln');
38     }
39     };
40     goto &{ $AUTOLOAD };
41 wakaba 1.3 } elsif ($ln = { ## Reflecting the URI value of a content attribute
42 wakaba 1.1 'Message::DOM::Atom::AtomElement::AtomContentElement::src' => 'src',
43     'Message::DOM::Atom::AtomElement::AtomCategoryElement::scheme' => 'scheme',
44     'Message::DOM::Atom::AtomElement::AtomGeneratorElement::uri' => 'uri',
45     'Message::DOM::Atom::AtomElement::AtomLinkElement::href' => 'href',
46     }->{$method_name}) {
47     no strict 'refs';
48     eval qq{
49     sub $method_name (\$;\$) {
50     local \$Error::Depth = \$Error::Depth + 1;
51    
52     if (\@_ > 1) {
53     if (defined \$_[1]) {
54     \$_[0]->set_attribute_ns (undef, '$ln', ''.\$_[1]);
55     } else {
56     \$_[0]->remove_attribute_ns (undef, '$ln');
57     }
58     return unless defined wantarray;
59     }
60    
61     my \$v = \$_[0]->get_attribute_ns (undef, '$ln');
62     if (defined \$v) {
63     my \$base = \$_[0]->base_uri;
64     if (defined \$base) {
65     return \$_[0]->owner_document->implementation
66     ->create_uri_reference (\$v)
67     ->get_absolute_reference (\$base)->uri_reference;
68     } else {
69     return \$v;
70     }
71     } else {
72     return undef;
73     }
74     }
75     };
76     goto &{ $AUTOLOAD };
77 wakaba 1.3 } elsif ($ln = { ## Reflecting the string value of a child element
78 wakaba 1.1 'Message::DOM::Atom::AtomElement::AtomPersonConstruct::email' => 'email',
79     'Message::DOM::Atom::AtomElement::AtomPersonConstruct::name' => 'name',
80     'Message::DOM::Atom::AtomElement::AtomFeedElement::id' => 'id',
81     'Message::DOM::Atom::AtomElement::AtomEntryElement::id' => 'id',
82     'Message::DOM::Atom::AtomElement::AtomSourceElement::id' => 'id',
83     }->{$method_name}) {
84     no strict 'refs';
85     eval qq{
86     sub $method_name (\$;\$) {
87     no warnings 'uninitialized';
88     local \$Error::Depth = \$Error::Depth + 1;
89    
90     if (\@_ > 1) {
91 wakaba 1.3 if (defined \$_[1]) {
92 wakaba 1.1 my \$target;
93     E: {
94 wakaba 1.3 for my \$cl (\@{\$_[0]->child_nodes}) {
95 wakaba 1.1 if (\$cl->node_type == 1 and # ELEMENT_NODE
96     \$cl->manakai_local_name eq '$ln' and
97 wakaba 1.3 \$cl->namespace_uri eq '$ATOM_NS') {
98 wakaba 1.1 \$target = \$cl;
99     last E;
100     }
101     }
102    
103     \$target = \$_[0]->owner_document->create_element_ns
104 wakaba 1.3 ('$ATOM_NS', '$ln');
105 wakaba 1.1 \$_[0]->append_child (\$target);
106     } # E
107    
108 wakaba 1.3 return \$target->text_content (\$_[1]);
109 wakaba 1.1 } else {
110     my \@remove;
111 wakaba 1.3 for my \$cl (\@{\$_[0]->child_nodes}) {
112 wakaba 1.1 if (\$cl->node_type == 1 and # ELEMENT_NODE
113     \$cl->manakai_local_name eq '$ln' and
114 wakaba 1.3 \$cl->namespace_uri eq '$ATOM_NS') {
115 wakaba 1.1 push \@remove, \$cl;
116     }
117     }
118    
119     \$_[0]->remove_child (\$_) for \@remove;
120     return undef;
121     }
122     }
123    
124 wakaba 1.3 for my \$cl (\@{\$_[0]->child_nodes}) {
125 wakaba 1.1 if (\$cl->node_type == 1 and # ELEMENT_NODE
126     \$cl->manakai_local_name eq '$ln' and
127 wakaba 1.3 \$cl->namespace_uri eq '$ATOM_NS') {
128 wakaba 1.1 return \$cl->text_content;
129     }
130     }
131    
132     return undef;
133     }
134     };
135     goto &{ $AUTOLOAD };
136 wakaba 1.3 } elsif ($ln = { ## Reflecting the URI value of a child element
137 wakaba 1.1 'Message::DOM::Atom::AtomElement::AtomPersonConstruct::uri' => 'uri',
138     'Message::DOM::Atom::AtomElement::AtomFeedElement::icon' => 'icon',
139     'Message::DOM::Atom::AtomElement::AtomFeedElement::logo' => 'logo',
140     'Message::DOM::Atom::AtomElement::AtomSourceElement::icon' => 'icon',
141     'Message::DOM::Atom::AtomElement::AtomSourceElement::logo' => 'logo',
142     }->{$method_name}) {
143     no strict 'refs';
144     eval qq{
145     sub $method_name (\$;\$) {
146     no warnings 'uninitialized';
147     local \$Error::Depth = \$Error::Depth + 1;
148    
149     if (\@_ > 1) {
150 wakaba 1.3 if (defined \$_[1]) {
151 wakaba 1.1 my \$target;
152     E: {
153 wakaba 1.3 for my \$cl (\@{\$_[0]->child_nodes}) {
154 wakaba 1.1 if (\$cl->node_type == 1 and # ELEMENT_NODE
155     \$cl->manakai_local_name eq '$ln' and
156 wakaba 1.3 \$cl->namespace_uri eq '$ATOM_NS') {
157 wakaba 1.1 \$target = \$cl;
158     last E;
159     }
160     }
161    
162     \$target = \$_[0]->owner_document->create_element_ns
163 wakaba 1.3 ('$ATOM_NS', '$ln');
164 wakaba 1.1 \$_[0]->append_child (\$target);
165     } # E
166    
167 wakaba 1.3 \$target->text_content (\$_[1]);
168 wakaba 1.1 return unless defined wantarray;
169     } else {
170     my \@remove;
171 wakaba 1.3 for my \$cl (\@{\$_[0]->child_nodes}) {
172 wakaba 1.1 if (\$cl->node_type == 1 and # ELEMENT_NODE
173     \$cl->manakai_local_name eq '$ln' and
174 wakaba 1.3 \$cl->namespace_uri eq '$ATOM_NS') {
175 wakaba 1.1 push \@remove, \$cl;
176     }
177     }
178    
179     \$_[0]->remove_child (\$_) for \@remove;
180     return undef;
181     }
182     }
183    
184 wakaba 1.3 for my \$cl (\@{\$_[0]->child_nodes}) {
185 wakaba 1.1 if (\$cl->node_type == 1 and # ELEMENT_NODE
186     \$cl->manakai_local_name eq '$ln' and
187 wakaba 1.3 \$cl->namespace_uri eq '$ATOM_NS') {
188 wakaba 1.1 my \$base = \$cl->base_uri;
189     if (defined \$base) {
190     return \$cl->owner_document->implementation
191     ->create_uri_reference (\$cl->text_content)
192     ->get_absolute_reference (\$base)->uri_reference;
193     } else {
194     return \$cl->text_content;
195     }
196     }
197     }
198    
199     return undef;
200     }
201     };
202     goto &{ $AUTOLOAD };
203 wakaba 1.3 } elsif ($ln = { ## Return the child element
204 wakaba 1.1 'Message::DOM::Atom::AtomElement::AtomPersonConstruct::name_element' => 'name',
205     'Message::DOM::Atom::AtomElement::AtomFeedElement::generator_element' => 'generator',
206     'Message::DOM::Atom::AtomElement::AtomFeedElement::rights_element' => 'rights',
207     'Message::DOM::Atom::AtomElement::AtomFeedElement::subtitle_element' => 'subtitle',
208     'Message::DOM::Atom::AtomElement::AtomFeedElement::title_element' => 'title',
209     'Message::DOM::Atom::AtomElement::AtomFeedElement::updated_element' => 'updated',
210     'Message::DOM::Atom::AtomElement::AtomEntryElement::content_element' => 'content',
211     'Message::DOM::Atom::AtomElement::AtomEntryElement::published_element' => 'published',
212     'Message::DOM::Atom::AtomElement::AtomEntryElement::rights_element' => 'rights',
213     'Message::DOM::Atom::AtomElement::AtomEntryElement::source_element' => 'source',
214     'Message::DOM::Atom::AtomElement::AtomEntryElement::summary_element' => 'summary',
215     'Message::DOM::Atom::AtomElement::AtomEntryElement::title_element' => 'title',
216     'Message::DOM::Atom::AtomElement::AtomEntryElement::updated_element' => 'updated',
217     'Message::DOM::Atom::AtomElement::AtomSourceElement::generator_element' => 'generator',
218     'Message::DOM::Atom::AtomElement::AtomSourceElement::rights_element' => 'rights',
219     'Message::DOM::Atom::AtomElement::AtomSourceElement::subtitle_element' => 'subtitle',
220     'Message::DOM::Atom::AtomElement::AtomSourceElement::title_element' => 'title',
221     'Message::DOM::Atom::AtomElement::AtomSourceElement::updated_element' => 'updated',
222     }->{$method_name}) {
223     no strict 'refs';
224     eval qq{
225     sub $method_name (\$) {
226     no warnings 'uninitialized';
227     local \$Error::Depth = \$Error::Depth + 1;
228    
229 wakaba 1.3 for my \$el (\@{\$_[0]->child_nodes}) {
230 wakaba 1.1 if (\$el->node_type == 1 and # ELEMENT_NODE
231     \$el->manakai_local_name eq '$ln' and
232 wakaba 1.3 \$el->namespace_uri eq '$ATOM_NS') {
233 wakaba 1.1 return \$el;
234     }
235     }
236    
237     my \$od = \$_[0]->owner_document;
238 wakaba 1.3 if (\$od->dom_config->get_parameter ('$CREATE_CHILD_URI')) {
239 wakaba 1.1 return \$_[0]->append_child
240 wakaba 1.3 (\$od->create_element_ns ('$ATOM_NS', '$ln'));
241 wakaba 1.1 } else {
242     return undef;
243     }
244     }
245     };
246     goto &{ $AUTOLOAD };
247 wakaba 1.3 } elsif ($ln = { ## Return a child element list
248 wakaba 1.1 'Message::DOM::Atom::AtomElement::AtomFeedElement::author_elements' => 'author',
249     'Message::DOM::Atom::AtomElement::AtomFeedElement::category_elements' => 'category',
250     'Message::DOM::Atom::AtomElement::AtomFeedElement::contributor_elements' => 'contributor',
251     'Message::DOM::Atom::AtomElement::AtomFeedElement::entry_elements' => 'entry',
252     'Message::DOM::Atom::AtomElement::AtomFeedElement::link_elements' => 'link',
253     'Message::DOM::Atom::AtomElement::AtomEntryElement::author_elements' => 'author',
254     'Message::DOM::Atom::AtomElement::AtomEntryElement::category_elements' => 'category',
255     'Message::DOM::Atom::AtomElement::AtomEntryElement::contributor_elements' => 'contributor',
256     'Message::DOM::Atom::AtomElement::AtomEntryElement::link_elements' => 'link',
257     'Message::DOM::Atom::AtomElement::AtomSourceElement::author_elements' => 'author',
258     'Message::DOM::Atom::AtomElement::AtomSourceElement::category_elements' => 'category',
259     'Message::DOM::Atom::AtomElement::AtomSourceElement::contributor_elements' => 'contributor',
260     'Message::DOM::Atom::AtomElement::AtomSourceElement::link_elements' => 'link',
261     }->{$method_name}) {
262     no strict 'refs';
263     eval qq{
264     sub $method_name (\$) {
265     local \$Error::Depth = \$Error::Depth + 1;
266     no warnings 'uninitialized';
267     my \$r = [];
268     for my \$el (\@{\$_[0]->child_nodes}) {
269     if (\$el->node_type == 1 and # ELEMENT_NODE
270     \$el->manakai_local_name eq '$ln' and
271 wakaba 1.3 \$el->namespace_uri eq '$ATOM_NS') {
272 wakaba 1.1 push \@\$r, \$el;
273     }
274     }
275     require Message::DOM::NodeList;
276     return bless \$r, 'Message::DOM::NodeList::StaticNodeList';
277     }
278     };
279     goto &{ $AUTOLOAD };
280     } else {
281     require Carp;
282     Carp::croak (qq<Can't locate method "$AUTOLOAD">);
283     }
284     } # AUTOLOAD
285    
286     package Message::DOM::Atom::AtomElement::AtomTextConstruct;
287     push our @ISA, 'Message::DOM::Atom::AtomElement';
288    
289     sub container ($) {
290     local $Error::Depth = $Error::Depth + 1;
291    
292     my $type = $_[0]->type;
293     if ($type eq 'xhtml') {
294     ## "Return the child element"
295     no warnings 'uninitialized';
296     for my $el (@{$_[0]->child_nodes}) {
297     if ($el->node_type == 1 and # ELEMENT_NODE
298     $el->manakai_local_name eq 'div' and
299     $el->namespace_uri eq q<http://www.w3.org/1999/xhtml>) {
300     return $el;
301     }
302     }
303    
304     my $od = $_[0]->owner_document;
305     if ($od->dom_config->get_parameter ($CREATE_CHILD_URI)) {
306     return $_[0]->append_child
307     ($od->create_element_ns (q<http://www.w3.org/1999/xhtml>, 'div'));
308     } else {
309     return undef;
310     }
311     } else {
312     return $_[0];
313     }
314     } # container
315    
316     sub type ($;$) {
317     local $Error::Depth = $Error::Depth + 1;
318    
319     if (@_ > 1) {
320     if (defined $_[1]) {
321     $_[0]->set_attribute_ns (undef, 'type', ''.$_[1]);
322     } else {
323     $_[0]->remove_attribute_ns (undef, 'type');
324     }
325    
326     return unless defined wantarray;
327     }
328    
329     my $v = $_[0]->get_attribute_ns (undef, 'type');
330     return defined $v ? $v : 'text';
331     } # type
332    
333     package Message::DOM::Atom::AtomElement::AtomPersonConstruct;
334     push our @ISA, 'Message::DOM::Atom::AtomElement';
335    
336     sub email ($;$);
337    
338     sub name ($;$);
339    
340     sub name_element ($);
341    
342     sub uri ($;$);
343    
344 wakaba 1.3 package Message::DOM::Atom::AtomElement::AtomDateConstruct;
345 wakaba 1.1 push our @ISA, 'Message::DOM::Atom::AtomElement';
346    
347     ## TODO: Use HTML5 algorithm
348     sub value ($;$) {
349     local $Error::Depth = $Error::Depth + 1;
350    
351     if (@_ > 1) {
352     my $given = 0+($_[1] or 0);
353     my @value = gmtime (int ($given / 1));
354     my $value = sprintf '%04d-%02d-%02dT%02d:%02d:%02d',
355     $value[5] + 1900, $value[4] + 1,
356     $value[3], $value[2], $value[1], $value[0];
357     my $f = $given % 1;
358     $value .= substr (''.$f, 1) if $f;
359     $value .= 'Z';
360     $_[0]->text_content ($value);
361     return unless defined wantarray;
362     }
363    
364     my $value = $_[0]->text_content;
365     if ($value =~ /\A(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)(\.\d+)?
366     (?:Z|([+-]\d+):(\d+))\z/x) {
367     require Time::Local;
368     my $r = Time::Local::timegm_nocheck
369     ($6, defined $8 ? $8 > 0 ? $5 - $9 : $5 + $9 : $5,
370     defined $8 ? $4 - $8 : $4, $3, $2-1, $1-1900);
371     $r += "0$7" if defined $7;
372     return $r;
373     } else {
374     return 0;
375     }
376     } # value
377    
378     package Message::DOM::Atom::AtomElement::AtomFeedElement;
379     push our @ISA, 'Message::DOM::Atom::AtomElement';
380    
381     sub add_new_entry ($$;$$) {
382     local $Error::Depth = $Error::Depth + 1;
383    
384     my $od = $_[0]->owner_document;
385     my $r = $od->create_element_ns ($ATOM_NS, 'entry');
386     $r->manakai_language (''.$_[3]) if defined $_[3];
387     $r->id (''.$_[1]);
388    
389     my $titlee = $od->create_element_ns ($ATOM_NS, 'title');
390     $titlee->text_content (defined $_[2] ? ''.$_[2] : '');
391     $r->append_child ($titlee);
392    
393     my $updatede = $od->create_element_ns ($ATOM_NS, 'updated');
394     $updatede->value (scalar time);
395     $r->append_child ($updatede);
396    
397     return $_[0]->append_child ($r);
398     } # add_new_entry
399    
400