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	wakaba	1.18	## NOTE: This module will be renamed as CharacterData.pm
2
3			package Message::DOM::CharacterData;
4	wakaba	1.1	use strict;
5	wakaba	1.18	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	wakaba	1.2	use Message::Util::Error;
9	wakaba	1.1
10	wakaba	1.18	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	wakaba	1.1
39	wakaba	1.18	sub child_nodes ($) {
40			require Message::DOM::NodeList;
41			return bless \\($_[0]), 'Message::DOM::NodeList::EmptyNodeList';
42			} # child_nodes
43	wakaba	1.1
44	wakaba	1.18	## \|CDATASection\|:
45			## The content of the CDATA section [DOM1, DOM2, DOM3].
46			## Same as \|CharacterData.data\| [DOM3].
47	wakaba	1.1
48	wakaba	1.18	## \|Comment\|:
49			## The content of the comment [DOM1, DOM2, DOM3].
50			## Same as \|CharacterData.data\| [DOM3].
51	wakaba	1.1
52	wakaba	1.18	## \|Text\|:
53			## The content of the text node [DOM1, DOM2, DOM3].
54			## Same as \|CharacterData.data\| [DOM3].
55	wakaba	1.1
56	wakaba	1.18	*node_value = \&data; # For \|CDATASection\|, \|Comment\|, and \|Text\|.
57	wakaba	1.1
58	wakaba	1.18	## 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	wakaba	1.1
63	wakaba	1.18	*text_content = \&node_value; # For \|CDATASection\|, \|Comment\|, and \|Text\|.
64	wakaba	1.1
65	wakaba	1.18	## \|Node\| methods
66	wakaba	1.1
67			sub append_child ($$) {
68	wakaba	1.18	report Message::DOM::DOMException
69			-object => $_[0],
70			-type => 'HIERARCHY_REQUEST_ERR',
71			-subtype => 'CHILD_NODE_TYPE_ERR';
72			} # append_child
73	wakaba	1.1
74			sub manakai_append_text ($$) {
75	wakaba	1.18	## 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	wakaba	1.1	}
83	wakaba	1.18	${$_[0]}->{data} .= ref $_[1] eq 'SCALAR' ? ${$_[1]} : $_[1];
84			} # manakai_append_text
85	wakaba	1.1
86	wakaba	1.18	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	wakaba	1.1
100	wakaba	1.18	## \|CharacterData\| attributes
101	wakaba	1.1
102	wakaba	1.18	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	wakaba	1.1
112	wakaba	1.18	if (defined $_[1]) {
113			${$_[0]}->{data} = ''.$_[1];
114	wakaba	1.1	} else {
115	wakaba	1.18	${$_[0]}->{data} = ''; # for \|text_content\|.
116	wakaba	1.1	}
117	wakaba	1.18	}
118	wakaba	1.1
119	wakaba	1.18	return ${$_[0]}->{data};
120			} # data
121	wakaba	1.1
122	wakaba	1.18	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	wakaba	1.1	}
144
145	wakaba	1.18	require Message::DOM::StringExtended;
146	wakaba	1.1
147	wakaba	1.18	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	wakaba	1.1
163	wakaba	1.18	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	wakaba	1.1	} else {
172	wakaba	1.18	$err->throw;
173	wakaba	1.1	}
174	wakaba	1.18	};
175	wakaba	1.1
176	wakaba	1.18	substr ($$self->{data}, $offset32, $eoffset32 - $offset32) = '';
177			return undef;
178			} # delete_data
179	wakaba	1.1
180	wakaba	1.18	sub insert_data ($$$) {
181			my $self = $_[0];
182			my $offset = 0+$_[1];
183	wakaba	1.1
184	wakaba	1.18	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	wakaba	1.1
192	wakaba	1.18	if ($offset < 0) {
193			report Message::DOM::DOMException
194			-object => $self,
195			-type => 'INDEX_SIZE_ERR',
196			-subtype => 'INDEX_OUT_OF_BOUND_ERR';
197	wakaba	1.2	}
198
199	wakaba	1.18	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	wakaba	1.2	}
229	wakaba	1.1
230	wakaba	1.18	require Message::DOM::StringExtended;
231	wakaba	1.1
232	wakaba	1.18	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	wakaba	1.3	} else {
244	wakaba	1.18	$err->throw;
245	wakaba	1.3	}
246	wakaba	1.18	};
247	wakaba	1.3
248	wakaba	1.18	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	wakaba	1.3	} else {
257	wakaba	1.18	$err->throw;
258	wakaba	1.3	}
259	wakaba	1.18	};
260	wakaba	1.2
261	wakaba	1.18	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	wakaba	1.2	}
276
277	wakaba	1.18	require Message::DOM::StringExtended;
278	wakaba	1.2
279	wakaba	1.18	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	wakaba	1.2
298	wakaba	1.18	package Message::DOM::CharacterData::Comment;
299			push our @ISA, 'Message::DOM::CharacterData', 'Message::IF::Comment';
300	wakaba	1.2
301	wakaba	1.18	## \|Node\| attributes
302	wakaba	1.2
303	wakaba	1.18	sub node_name () { '#comment' }
304	wakaba	1.2
305	wakaba	1.18	sub node_type () { 8 } # COMMENT_NODE
306	wakaba	1.2
307	wakaba	1.18	package Message::IF::CharacterData;
308			package Message::IF::Comment;
309	wakaba	1.2
310	wakaba	1.18	package Message::DOM::Document;
311	wakaba	1.1
312	wakaba	1.18	sub create_comment ($$) {
313			return Message::DOM::CharacterData::Comment->____new ($_[0], $_[1]);
314			} # create_comment
315	wakaba	1.1
316	wakaba	1.18	=head1 LICENSE
317	wakaba	1.1
318	wakaba	1.18	Copyright 2007 Wakaba <w@suika.fam.cx>
319	wakaba	1.1
320	wakaba	1.18	This program is free software; you can redistribute it and/or
321			modify it under the same terms as Perl itself.
322	wakaba	1.1
323	wakaba	1.18	=cut
324	wakaba	1.1
325			1;
326	wakaba	1.18	## $Date: 2007/07/14 10:28:52 $