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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (show annotations) (download)
Sat Jul 14 16:32:28 2007 UTC (17 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.9: +3 -3 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 package Message::DOM::Text;
2 use strict;
3 our $VERSION=do{my @r=(q$Revision: 1.9 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 push our @ISA, 'Message::DOM::CharacterData', 'Message::IF::Text';
5 require Message::DOM::DOMCharacterData; ## TODO: Change to new module name
6
7 ## |Node| attributes
8
9 sub node_name () { '#text' }
10
11 sub node_type () { 3 } # TEXT_NODE
12
13 ## |Text| attributes
14
15 sub is_element_content_whitespace ($;$) {
16 if (@_ > 1) {
17 ## TODO: Document how setter work
18 if (${$_[0]}->{manakai_read_only}) {
19 report Message::DOM::DOMException
20 -object => $_[0],
21 -type => 'NO_MODIFICATION_ALLOWED_ERR',
22 -subtype => 'READ_ONLY_NODE_ERR';
23 }
24
25 if ($_[1]) {
26 ${$_[0]}->{is_element_content_whitespace} = 1;
27 } else {
28 delete ${$_[0]}->{is_element_content_whitespace};
29 }
30 }
31 return ${$_[0]}->{is_element_content_whitespace};
32 } # is_element_content_whitespace
33
34 sub whole_text ($) {
35 require Message::DOM::Traversal;
36 local $Error::Depth = $Error::Depth + 1;
37 my $doc = $_[0]->owner_document;
38 my $tw1 = $doc->create_tree_walker
39 ($doc, 0xFFFFFFFF, sub { # SHOW_ALL ENTITY_REFERENCE_NODE
40 ($_[0]->node_type == 5) ? 3 : 1; # FILTER_SKIP FILTER_ACCEPT
41 }, 1);
42 $tw1->current_node ($_[0]);
43
44 my $tw2 = $tw1->clone;
45 my $r = $_[0]->node_value;
46
47 S: while (defined (my $node = $tw1->previous_sibling)) {
48 my $nt = $node->node_type;
49 if ($nt == 3 or $nt == 4) { # TEXT_NODE CDATA_SECTION_NODE
50 $r = $node->node_value . $r;
51 } else {
52 last S;
53 }
54 } # S
55
56 S: while (defined (my $node = $tw2->next_sibling)) {
57 my $nt = $node->node_type;
58 if ($nt == 3 or $nt == 4) { # TEXT_NODE CDATA_SECTION_NODE
59 $r .= $node->node_value;
60 } else {
61 last S;
62 }
63 } # S
64
65 return $r;
66
67 ## TODO: Skipping |DocumentType| is manakai-extension. Document it!
68 } # whole_text
69
70 ## |Text| methods
71
72 ## TODO: replace_whole_text
73
74 sub split_text ($;$) {
75 my $parent = $_[0]->parent_node;
76 if (${${$_[0]}->{owner_document}}->{strict_error_checking}) {
77 if (${$_[0]}->{manakai_read_only}) {
78 report Message::DOM::DOMException
79 -object => $_[0],
80 -type => 'NO_MODIFICATION_ALLOWED_ERR',
81 -subtype => 'READ_ONLY_NODE_ERR';
82 }
83
84 if (defined $parent and $$parent->{manakai_read_only}) {
85 report Message::DOM::DOMException
86 -object => $_[0],
87 -type => 'NO_MODIFICATION_ALLOWED_ERR',
88 -subtype => 'READ_ONLY_NODE_ERR';
89 }
90 }
91
92 require Message::DOM::StringExtended;
93 local $Error::Depth = $Error::Depth + 1;
94 my $offset32 = Message::DOM::StringExtended::find_offset32
95 (${$_[0]}->{data}, $_[1]);
96 my $data2 = substr ${$_[0]}->{data}, $offset32;
97
98 my $r = $_[0]->node_type == 3 # TEXT_NODE
99 ? ${$_[0]}->{owner_document}->create_text_node ($data2)
100 : ${$_[0]}->{owner_document}->create_cdata_section ($data2);
101 $r->is_element_content_whitespace ($_[0]->is_element_content_whitespace);
102 substr (${$_[0]}->{data}, $offset32) = '';
103
104 if (defined $parent) {
105 $parent->insert_before ($r, $_[0]->next_sibling);
106 }
107
108 return $r;
109 } # split_text
110
111 package Message::DOM::Text::CDATASection;
112 push our @ISA, 'Message::DOM::Text', 'Message::IF::CDATASection';
113
114 ## |Node| attributes
115
116 sub node_name () { '#cdata-section' }
117
118 sub node_type () { 4 } # CDATA_SECTION_NODE
119
120 ## |Text| attribute
121
122 sub is_element_content_whitespace () { 0 }
123
124 package Message::IF::Text;
125 package Message::IF::CDATASection;
126
127 package Message::DOM::Document;
128
129 sub create_cdata_section ($$) {
130 return Message::DOM::Text::CDATASection->____new (@_[0, 1]);
131 } # create_cdata_section
132
133 sub create_text_node ($$) {
134 return Message::DOM::Text->____new ($_[0], $_[1]);
135 } # create_text_node
136
137 =head1 LICENSE
138
139 Copyright 2007 Wakaba <w@suika.fam.cx>
140
141 This program is free software; you can redistribute it and/or
142 modify it under the same terms as Perl itself.
143
144 =cut
145
146 1;
147 ## $Date: 2007/07/14 10:28:52 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24