Message/DOM/Text.pm

package Message::DOM::Text;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::DOM::CharacterData', 'Message::IF::Text';
require Message::DOM::DOMCharacterData; ## TODO: Change to new module name

sub AUTOLOAD {
  my $method_name = our $AUTOLOAD;
  $method_name =~ s/.*:://;
  return if $method_name eq 'DESTROY';

  if ({
    ## Read-only attributes (trivial accessors)
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        if (\@_ > 1) {
          require Carp;
          Carp::croak (qq<Can't modify read-only attribute>);
        }
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (DOMString, trivial accessors)
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        if (\@_ > 1) {
          \${\$_[0]}->{$method_name} = ''.$_[1];
        }
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

## |Node| attributes

sub node_name () { '#text' }

sub node_type { 3 } # TEXT_NODE

## |Text| attributes

sub is_element_content_whitespace ($;$) {
  if (@_ > 1) {
    ## TODO: Document how setter work
    if (${$_[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }

    if ($_[1]) {
      ${$_[0]}->{is_element_content_whitespace} = 1;
    } else {
      delete ${$_[0]}->{is_element_content_whitespace};
    }
  }
  return ${$_[0]}->{is_element_content_whitespace};
} # is_element_content_whitespace

sub whole_text ($) {
  require Message::DOM::Traversal;
  local $Error::Depth = $Error::Depth + 1;
  my $doc = $_[0]->owner_document;
  my $tw1 = $doc->create_tree_walker
      ($doc, 0xFFFFFFFF, sub { # SHOW_ALL ENTITY_REFERENCE_NODE
        ($_[1]->node_type == 5) ? 3 : 1; # FILTER_SKIP FILTER_ACCEPT
      }, 1);
  $tw1->current_node ($_[0]);
  
  my $tw2 = $tw1->clone;
  my $r = $_[0]->node_value;

  S: while (defined (my $node = $tw1->previous_sibling)) {
    my $nt = $node->node_type;
    if ($nt == 3 or $nt == 4) { # TEXT_NODE CDATA_SECTION_NODE
      $r = $node->node_value . $r;
    } else {
      last S;
    }
  } # S

  S: while (defined (my $node = $tw2->next_sibling)) {
    my $nt = $node->node_type;
    if ($nt == 3 or $nt == 4) { # TEXT_NODE CDATA_SECTION_NODE
      $r .= $node->node_value;
    } else {
      last S;
    }
  } # S

  return $r;

  ## TODO: Skipping |DocumentType| is manakai-extension.  Document it!
} # whole_text

## |Text| methods

sub split_text ($;$) {
  my $parent = $_[0]->parent_node;
  if (${${$_[0]}->{owner_document}}->{strict_error_checking}) {
    if (${$_[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }

    if (defined $parent and $$parent->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }
  }

  require Message::DOM::StringExtended;
  local $Error::Depth = $Error::Depth + 1;
  my $offset32 = Message::DOM::StringExtended::find_offset32
      (${$_[0]}->{data}, $_[1]);
  my $data2 = substr ${$_[0]}->{data}, $offset32;

  my $r = $_[0]->node_type == 3 # TEXT_NODE
      ? ${$_[0]}->{owner_document}->create_text_node ($data2)
      : ${$_[0]}->{owner_document}->create_cdata_section ($data2);
  $r->is_element_content_whitespace ($_[0]->is_element_content_whitespace);
  substr (${$_[0]}->{data}, $offset32) = '';

  if (defined $parent) {
    $parent->insert_before ($r, $_[0]->next_sibling);
  }

  return $r;
} # split_text

package Message::IF::Text;

package Message::DOM::Document;

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

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