Message/DOM/CharacterData.pm

## NOTE: This module will be renamed as CharacterData.pm

package Message::DOM::CharacterData;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.10 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::DOM::Node', 'Message::IF::CharacterData';
require Message::DOM::Node;
use Message::Util::Error;

sub ____new ($$$) {
  my $self = shift->SUPER::____new (shift);
  $$self->{data} = ''.(ref $_[0] eq 'SCALAR' ? ${$_[0]} : $_[0]);
  return $self;
} # ____new
             
## |Node| attributes

sub base_uri ($) {
  ## NOTE: Same as |EntityReference|'s.

  my $self = $_[0];
  local $Error::Depth = $Error::Depth + 1;
  my $pe = $$self->{parent_node};
  while (defined $pe) {
    my $nt = $pe->node_type;
    if ($nt == 1 or $nt == 2 or $nt == 6 or $nt == 9 or $nt == 11) {
      ## Element, Attr, Entity, Document, or DocumentFragment
      return $pe->base_uri;
    } elsif ($nt == 5) {
      ## EntityReference
      return $pe->manakai_entity_base_uri if $pe->manakai_external;
    }
    $pe = $$pe->{parent_node};
  }
  return $pe->base_uri if $pe;
  return $$self->{owner_document}->base_uri;
} # base_uri

sub child_nodes ($) {
  require Message::DOM::NodeList;
  return bless \\($_[0]), 'Message::DOM::NodeList::EmptyNodeList';
} # child_nodes

## |CDATASection|:
## The content of the CDATA section [DOM1, DOM2, DOM3].
## Same as |CharacterData.data| [DOM3].

## |Comment|:
## The content of the comment [DOM1, DOM2, DOM3].
## Same as |CharacterData.data| [DOM3].

## |Text|:
## The content of the text node [DOM1, DOM2, DOM3].
## Same as |CharacterData.data| [DOM3].

*node_value = \&data; # For |CDATASection|, |Comment|, and |Text|.

## ISSUE: DOM3 Core does not explicitly say setting |null|
## on read-only node is ignored.  Strictly speaking, it does not even
## say what the setter does for |CharacterData| and PI nodes.
## What if setting |null| to non read-only |CharacterData| or PI?

*text_content = \&node_value; # For |CDATASection|, |Comment|, and |Text|.

## |Node| methods

sub append_child ($$) {
  report Message::DOM::DOMException
      -object => $_[0],
      -type => 'HIERARCHY_REQUEST_ERR',
      -subtype => 'CHILD_NODE_TYPE_ERR';
} # append_child

sub manakai_append_text ($$) {
  ## NOTE: Same as |ProcessingInstruction|'s.
  if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
      ${$_[0]}->{manakai_read_only}) {
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'NO_MODIFICATION_ALLOWED_ERR',
        -subtype => 'READ_ONLY_NODE_ERR';
  }
  ${$_[0]}->{data} .= ref $_[1] eq 'SCALAR' ? ${$_[1]} : $_[1];
} # manakai_append_text

sub insert_before ($;$) {
  report Message::DOM::DOMException
      -object => $_[0],
      -type => 'HIERARCHY_REQUEST_ERR',
      -subtype => 'CHILD_NODE_TYPE_ERR';
} # insert_before

sub replace_child ($$) {
  report Message::DOM::DOMException
      -object => $_[0],
      -type => 'HIERARCHY_REQUEST_ERR',
      -subtype => 'CHILD_NODE_TYPE_ERR';
} # replace_child

## |CharacterData| attributes

sub data ($;$) {
  if (@_ > 1) {
    if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
        ${$_[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }

    if (defined $_[1]) {
      ${$_[0]}->{data} = ''.$_[1];
    } else {
      ${$_[0]}->{data} = ''; # for |text_content|.
    }
  }

  return ${$_[0]}->{data};
} # data

sub length ($) {
  my $self = $_[0];
  my $r = CORE::length $$self->{data};
  $r++ while $$self->{data} =~ /[\x{10000}-\x{10FFFF}]/g;
  return $r;
} # length

## |CharacterData| methods

*append_data = \&manakai_append_text;

sub delete_data ($;$) {
  my $self = $_[0];
  my $offset = 0+$_[1];
  my $count = 0+$_[2];
  
  if ($offset < 0 or $count < 0) {
    report Message::DOM::DOMException
        -object => $self,
        -type => 'INDEX_SIZE_ERR',
        -subtype => 'INDEX_OUT_OF_BOUND_ERR';
  }

  require Message::DOM::StringExtended;

  my $offset32;
  try {
    $offset32 = Message::DOM::StringExtended::find_offset32
        ($$self->{data}, $offset);
  } catch Error::Simple with {
    my $err = shift;
    if ($err->text eq "String index out of bounds\n") {
      report Message::DOM::DOMException
          -object => $self,
          -type => 'INDEX_SIZE_ERR',
          -subtype => 'INDEX_OUT_OF_BOUND_ERR';
    } else {
      $err->throw;
    }
  };

  my $eoffset32;
  try {
    $eoffset32 = Message::DOM::StringExtended::find_offset32
        ($$self->{data}, $offset + $count);
  } catch Error::Simple with {
    my $err = shift;
    if ($err->text eq "String index out of bounds\n") {
      $eoffset32 = ($offset + $count) * 2;
    } else {
      $err->throw;
    }
  };

  substr ($$self->{data}, $offset32, $eoffset32 - $offset32) = '';
  return undef;
} # delete_data

sub insert_data ($$$) {
  my $self = $_[0];
  my $offset = 0+$_[1];

  if (${$$self->{owner_document}}->{strict_error_checking} and
      $$self->{manakai_read_only}) {
    report Message::DOM::DOMException
        -object => $self,
        -type => 'NO_MODIFICATION_ALLOWED_ERR',
        -subtype => 'READ_ONLY_NODE_ERR';
  }

  if ($offset < 0) {
    report Message::DOM::DOMException
        -object => $self,
        -type => 'INDEX_SIZE_ERR',
        -subtype => 'INDEX_OUT_OF_BOUND_ERR';
  }

  require Message::DOM::StringExtended;
  my $offset32;
  try {
    $offset32 = Message::DOM::StringExtended::find_offset32
        ($$self->{data}, $offset);
  } catch Error::Simple with {
    my $err = shift;
    if ($err->text eq "String index out of bounds\n") {
      report Message::DOM::DOMException
          -object => $self,
          -type => 'INDEX_SIZE_ERR',
          -subtype => 'INDEX_OUT_OF_BOUND_ERR';
    } else {
      $err->throw;
    }
  };
  substr ($$self->{data}, $offset32, 0) = $_[2];
} # insert_data

sub replace_data ($;$$) {
  my $self = $_[0];
  my $offset = 0+$_[1];
  my $count = 0+$_[2];
  
  if ($offset < 0 or $count < 0) {
    report Message::DOM::DOMException
        -object => $self,
        -type => 'INDEX_SIZE_ERR',
        -subtype => 'INDEX_OUT_OF_BOUND_ERR';
  }

  require Message::DOM::StringExtended;

  my $offset32;
  try {
    $offset32 = Message::DOM::StringExtended::find_offset32
        ($$self->{data}, $offset);
  } catch Error::Simple with {
    my $err = shift;
    if ($err->text eq "String index out of bounds\n") {
      report Message::DOM::DOMException
          -object => $self,
          -type => 'INDEX_SIZE_ERR',
          -subtype => 'INDEX_OUT_OF_BOUND_ERR';
    } else {
      $err->throw;
    }
  };

  my $eoffset32;
  try {
    $eoffset32 = Message::DOM::StringExtended::find_offset32
        ($$self->{data}, $offset + $count);
  } catch Error::Simple with {
    my $err = shift;
    if ($err->text eq "String index out of bounds\n") {
      $eoffset32 = ($offset + $count) * 2;
    } else {
      $err->throw;
    }
  };

  substr ($$self->{data}, $offset32, $eoffset32 - $offset32) = $_[3];
  return undef;
} # replace_data

sub substring_data ($;$$) {
  my $self = $_[0];
  my $offset = 0+$_[1];
  my $count = 0+$_[2];
  
  if ($offset < 0 or $count < 0) {
    report Message::DOM::DOMException
        -object => $self,
        -type => 'INDEX_SIZE_ERR',
        -subtype => 'INDEX_OUT_OF_BOUND_ERR';
  }

  require Message::DOM::StringExtended;

  my $eoffset32;
  try {
    $eoffset32 = Message::DOM::StringExtended::find_offset32
        ($$self->{data}, $offset + $count);
  } catch Error::Simple with {
    my $err = shift;
    if ($err->text eq "String index out of bounds\n") {
      $eoffset32 = ($offset + $count) * 2;
    } else {
      $err->throw;
    }
  };
   
  local $Error::Depth = $Error::Depth + 1;
  my $offset32 = Message::DOM::StringExtended::find_offset32
      ($$self->{data}, $offset);
  return substr $$self->{data}, $offset32, $eoffset32 - $offset32;
} # substring_data

package Message::DOM::CharacterData::Comment;
push our @ISA, 'Message::DOM::CharacterData', 'Message::IF::Comment';

## |Node| attributes

sub node_name () { '#comment' }

sub node_type () { 8 } # COMMENT_NODE

package Message::IF::CharacterData;
package Message::IF::Comment;

package Message::DOM::Document;

sub create_comment ($$) {
  return Message::DOM::CharacterData::Comment->____new ($_[0], $_[1]);
} # create_comment

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1;
## $Date: 2007/07/14 10:28:52 $
1	## NOTE: This module will be renamed as CharacterData.pm
2
3	package Message::DOM::CharacterData;
4	use strict;
5	our $VERSION=do{my @r=(q$Revision: 1.10 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
6	push our @ISA, 'Message::DOM::Node', 'Message::IF::CharacterData';
7	require Message::DOM::Node;
8	use Message::Util::Error;
9
10	sub ____new ($$$) {
11	my $self = shift->SUPER::____new (shift);
12	$$self->{data} = ''.(ref $_[0] eq 'SCALAR' ? ${$_[0]} : $_[0]);
13	return $self;
14	} # ____new
15
16	## \|Node\| attributes
17
18	sub base_uri ($) {
19	## NOTE: Same as \|EntityReference\|'s.
20
21	my $self = $_[0];
22	local $Error::Depth = $Error::Depth + 1;
23	my $pe = $$self->{parent_node};
24	while (defined $pe) {
25	my $nt = $pe->node_type;
26	if ($nt == 1 or $nt == 2 or $nt == 6 or $nt == 9 or $nt == 11) {
27	## Element, Attr, Entity, Document, or DocumentFragment
28	return $pe->base_uri;
29	} elsif ($nt == 5) {
30	## EntityReference
31	return $pe->manakai_entity_base_uri if $pe->manakai_external;
32	}
33	$pe = $$pe->{parent_node};
34	}
35	return $pe->base_uri if $pe;
36	return $$self->{owner_document}->base_uri;
37	} # base_uri
38
39	sub child_nodes ($) {
40	require Message::DOM::NodeList;
41	return bless \\($_[0]), 'Message::DOM::NodeList::EmptyNodeList';
42	} # child_nodes
43
44	## \|CDATASection\|:
45	## The content of the CDATA section [DOM1, DOM2, DOM3].
46	## Same as \|CharacterData.data\| [DOM3].
47
48	## \|Comment\|:
49	## The content of the comment [DOM1, DOM2, DOM3].
50	## Same as \|CharacterData.data\| [DOM3].
51
52	## \|Text\|:
53	## The content of the text node [DOM1, DOM2, DOM3].
54	## Same as \|CharacterData.data\| [DOM3].
55
56	*node_value = \&data; # For \|CDATASection\|, \|Comment\|, and \|Text\|.
57
58	## ISSUE: DOM3 Core does not explicitly say setting \|null\|
59	## on read-only node is ignored. Strictly speaking, it does not even
60	## say what the setter does for \|CharacterData\| and PI nodes.
61	## What if setting \|null\| to non read-only \|CharacterData\| or PI?
62
63	*text_content = \&node_value; # For \|CDATASection\|, \|Comment\|, and \|Text\|.
64
65	## \|Node\| methods
66
67	sub append_child ($$) {
68	report Message::DOM::DOMException
69	-object => $_[0],
70	-type => 'HIERARCHY_REQUEST_ERR',
71	-subtype => 'CHILD_NODE_TYPE_ERR';
72	} # append_child
73
74	sub manakai_append_text ($$) {
75	## NOTE: Same as \|ProcessingInstruction\|'s.
76	if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
77	${$_[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	${$_[0]}->{data} .= ref $_[1] eq 'SCALAR' ? ${$_[1]} : $_[1];
84	} # manakai_append_text
85
86	sub insert_before ($;$) {
87	report Message::DOM::DOMException
88	-object => $_[0],
89	-type => 'HIERARCHY_REQUEST_ERR',
90	-subtype => 'CHILD_NODE_TYPE_ERR';
91	} # insert_before
92
93	sub replace_child ($$) {
94	report Message::DOM::DOMException
95	-object => $_[0],
96	-type => 'HIERARCHY_REQUEST_ERR',
97	-subtype => 'CHILD_NODE_TYPE_ERR';
98	} # replace_child
99
100	## \|CharacterData\| attributes
101
102	sub data ($;$) {
103	if (@_ > 1) {
104	if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
105	${$_[0]}->{manakai_read_only}) {
106	report Message::DOM::DOMException
107	-object => $_[0],
108	-type => 'NO_MODIFICATION_ALLOWED_ERR',
109	-subtype => 'READ_ONLY_NODE_ERR';
110	}
111
112	if (defined $_[1]) {
113	${$_[0]}->{data} = ''.$_[1];
114	} else {
115	${$_[0]}->{data} = ''; # for \|text_content\|.
116	}
117	}
118
119	return ${$_[0]}->{data};
120	} # data
121
122	sub length ($) {
123	my $self = $_[0];
124	my $r = CORE::length $$self->{data};
125	$r++ while $$self->{data} =~ /[\x{10000}-\x{10FFFF}]/g;
126	return $r;
127	} # length
128
129	## \|CharacterData\| methods
130
131	*append_data = \&manakai_append_text;
132
133	sub delete_data ($;$) {
134	my $self = $_[0];
135	my $offset = 0+$_[1];
136	my $count = 0+$_[2];
137
138	if ($offset < 0 or $count < 0) {
139	report Message::DOM::DOMException
140	-object => $self,
141	-type => 'INDEX_SIZE_ERR',
142	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
143	}
144
145	require Message::DOM::StringExtended;
146
147	my $offset32;
148	try {
149	$offset32 = Message::DOM::StringExtended::find_offset32
150	($$self->{data}, $offset);
151	} catch Error::Simple with {
152	my $err = shift;
153	if ($err->text eq "String index out of bounds\n") {
154	report Message::DOM::DOMException
155	-object => $self,
156	-type => 'INDEX_SIZE_ERR',
157	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
158	} else {
159	$err->throw;
160	}
161	};
162
163	my $eoffset32;
164	try {
165	$eoffset32 = Message::DOM::StringExtended::find_offset32
166	($$self->{data}, $offset + $count);
167	} catch Error::Simple with {
168	my $err = shift;
169	if ($err->text eq "String index out of bounds\n") {
170	$eoffset32 = ($offset + $count) * 2;
171	} else {
172	$err->throw;
173	}
174	};
175
176	substr ($$self->{data}, $offset32, $eoffset32 - $offset32) = '';
177	return undef;
178	} # delete_data
179
180	sub insert_data ($$$) {
181	my $self = $_[0];
182	my $offset = 0+$_[1];
183
184	if (${$$self->{owner_document}}->{strict_error_checking} and
185	$$self->{manakai_read_only}) {
186	report Message::DOM::DOMException
187	-object => $self,
188	-type => 'NO_MODIFICATION_ALLOWED_ERR',
189	-subtype => 'READ_ONLY_NODE_ERR';
190	}
191
192	if ($offset < 0) {
193	report Message::DOM::DOMException
194	-object => $self,
195	-type => 'INDEX_SIZE_ERR',
196	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
197	}
198
199	require Message::DOM::StringExtended;
200	my $offset32;
201	try {
202	$offset32 = Message::DOM::StringExtended::find_offset32
203	($$self->{data}, $offset);
204	} catch Error::Simple with {
205	my $err = shift;
206	if ($err->text eq "String index out of bounds\n") {
207	report Message::DOM::DOMException
208	-object => $self,
209	-type => 'INDEX_SIZE_ERR',
210	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
211	} else {
212	$err->throw;
213	}
214	};
215	substr ($$self->{data}, $offset32, 0) = $_[2];
216	} # insert_data
217
218	sub replace_data ($;$$) {
219	my $self = $_[0];
220	my $offset = 0+$_[1];
221	my $count = 0+$_[2];
222
223	if ($offset < 0 or $count < 0) {
224	report Message::DOM::DOMException
225	-object => $self,
226	-type => 'INDEX_SIZE_ERR',
227	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
228	}
229
230	require Message::DOM::StringExtended;
231
232	my $offset32;
233	try {
234	$offset32 = Message::DOM::StringExtended::find_offset32
235	($$self->{data}, $offset);
236	} catch Error::Simple with {
237	my $err = shift;
238	if ($err->text eq "String index out of bounds\n") {
239	report Message::DOM::DOMException
240	-object => $self,
241	-type => 'INDEX_SIZE_ERR',
242	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
243	} else {
244	$err->throw;
245	}
246	};
247
248	my $eoffset32;
249	try {
250	$eoffset32 = Message::DOM::StringExtended::find_offset32
251	($$self->{data}, $offset + $count);
252	} catch Error::Simple with {
253	my $err = shift;
254	if ($err->text eq "String index out of bounds\n") {
255	$eoffset32 = ($offset + $count) * 2;
256	} else {
257	$err->throw;
258	}
259	};
260
261	substr ($$self->{data}, $offset32, $eoffset32 - $offset32) = $_[3];
262	return undef;
263	} # replace_data
264
265	sub substring_data ($;$$) {
266	my $self = $_[0];
267	my $offset = 0+$_[1];
268	my $count = 0+$_[2];
269
270	if ($offset < 0 or $count < 0) {
271	report Message::DOM::DOMException
272	-object => $self,
273	-type => 'INDEX_SIZE_ERR',
274	-subtype => 'INDEX_OUT_OF_BOUND_ERR';
275	}
276
277	require Message::DOM::StringExtended;
278
279	my $eoffset32;
280	try {
281	$eoffset32 = Message::DOM::StringExtended::find_offset32
282	($$self->{data}, $offset + $count);
283	} catch Error::Simple with {
284	my $err = shift;
285	if ($err->text eq "String index out of bounds\n") {
286	$eoffset32 = ($offset + $count) * 2;
287	} else {
288	$err->throw;
289	}
290	};
291
292	local $Error::Depth = $Error::Depth + 1;
293	my $offset32 = Message::DOM::StringExtended::find_offset32
294	($$self->{data}, $offset);
295	return substr $$self->{data}, $offset32, $eoffset32 - $offset32;
296	} # substring_data
297
298	package Message::DOM::CharacterData::Comment;
299	push our @ISA, 'Message::DOM::CharacterData', 'Message::IF::Comment';
300
301	## \|Node\| attributes
302
303	sub node_name () { '#comment' }
304
305	sub node_type () { 8 } # COMMENT_NODE
306
307	package Message::IF::CharacterData;
308	package Message::IF::Comment;
309
310	package Message::DOM::Document;
311
312	sub create_comment ($$) {
313	return Message::DOM::CharacterData::Comment->____new ($_[0], $_[1]);
314	} # create_comment
315
316	=head1 LICENSE
317
318	Copyright 2007 Wakaba <w@suika.fam.cx>
319
320	This program is free software; you can redistribute it and/or
321	modify it under the same terms as Perl itself.
322
323	=cut
324
325	1;
326	## $Date: 2007/07/14 10:28:52 $