Message/DOM/ProcessingInstruction.pm

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

sub ____new ($$$$) {
  my $self = shift->SUPER::____new (shift);
  ($$self->{target}, $$self->{data}) = @_;
  return $self;
} # ____new
             
sub AUTOLOAD {
  my $method_name = our $AUTOLOAD;
  $method_name =~ s/.*:://;
  return if $method_name eq 'DESTROY';

  if ({
    ## Read-only attributes (trivial accessors)
    target => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (DOMString, trivial accessors)
    manakai_base_uri => 1,
    data => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$;\$) {
        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]}->{$method_name} = ''.\$_[1];
          } else {
            delete \${\$_[0]}->{$method_name};
          }
        }
        return \${\$_[0]}->{$method_name};
      }
    };
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

## |Node| attributes

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

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

*node_name = \&target;

sub node_type () { 7 } # PROCESSING_INSTRUCTION_NODE

*node_value = \&data;

*text_content = \&node_value;

## |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 |CharacterData|'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

## |ProcessingInstruction| attributes

sub manakai_base_uri ($;$);

sub data ($;$);

sub target ($);

package Message::IF::ProcessingInstruction;

package Message::DOM::Document;

sub create_processing_instruction ($$$) {
  if (${$_[0]}->{strict_error_checking}) {
    my $xv = $_[0]->xml_version;
    if (defined $xv) {
      if ($xv eq '1.0' and
          $_[1] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
        #
      } elsif ($xv eq '1.1' and
               $_[1] =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) {
        #
      } else {
        report Message::DOM::DOMException
            -object => $_[0],
            -type => 'INVALID_CHARACTER_ERR',
            -subtype => 'MALFORMED_NAME_ERR';
      }
    }
  }

  return Message::DOM::ProcessingInstruction->____new (@_[0, 1, 2]);
} # create_processing_instruction

=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/08 13:04:37 $
1	wakaba	1.1	package Message::DOM::ProcessingInstruction;
2			use strict;
3	wakaba	1.10	our $VERSION=do{my @r=(q$Revision: 1.9 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.1	push our @ISA, 'Message::DOM::Node', 'Message::IF::ProcessingInstruction';
5			require Message::DOM::Node;
6
7			sub ____new ($$$$) {
8			my $self = shift->SUPER::____new (shift);
9			($$self->{target}, $$self->{data}) = @_;
10			return $self;
11			} # ____new
12
13			sub AUTOLOAD {
14			my $method_name = our $AUTOLOAD;
15			$method_name =~ s/.*:://;
16			return if $method_name eq 'DESTROY';
17
18			if ({
19			## Read-only attributes (trivial accessors)
20			target => 1,
21			}->{$method_name}) {
22			no strict 'refs';
23			eval qq{
24			sub $method_name (\$) {
25			return \${\$_[0]}->{$method_name};
26			}
27			};
28			goto &{ $AUTOLOAD };
29			} elsif ({
30			## Read-write attributes (DOMString, trivial accessors)
31	wakaba	1.5	manakai_base_uri => 1,
32	wakaba	1.6	data => 1,
33	wakaba	1.1	}->{$method_name}) {
34			no strict 'refs';
35			eval qq{
36	wakaba	1.5	sub $method_name (\$;\$) {
37	wakaba	1.1	if (\@_ > 1) {
38	wakaba	1.5	if (\${\${\$_[0]}->{owner_document}}->{strict_error_checking} and
39			\${\$_[0]}->{manakai_read_only}) {
40			report Message::DOM::DOMException
41			-object => \$_[0],
42			-type => 'NO_MODIFICATION_ALLOWED_ERR',
43			-subtype => 'READ_ONLY_NODE_ERR';
44			}
45			if (defined \$_[1]) {
46			\${\$_[0]}->{$method_name} = ''.\$_[1];
47			} else {
48			delete \${\$_[0]}->{$method_name};
49			}
50	wakaba	1.1	}
51	wakaba	1.5	return \${\$_[0]}->{$method_name};
52	wakaba	1.1	}
53			};
54			goto &{ $AUTOLOAD };
55			} else {
56			require Carp;
57			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
58			}
59			} # AUTOLOAD
60
61	wakaba	1.5	## \|Node\| attributes
62
63			sub base_uri ($) {
64			my $self = $_[0];
65			return $$self->{manakai_base_uri} if defined $$self->{manakai_base_uri};
66
67			local $Error::Depth = $Error::Depth + 1;
68			my $node = $$self->{parent_node};
69			while (defined $node) {
70			my $nt = $node->node_type;
71			if ($nt == 1 or $nt == 6 or $nt == 9 or $nt == 10 or $nt == 11) {
72			## Element, Entity, Document, DocumentType, or DocumentFragment
73			return $node->base_uri;
74			} elsif ($nt == 5) {
75			## EntityReference
76			return $node->manakai_entity_base_uri if $node->manakai_external;
77			}
78			$node = $$node->{parent_node};
79			}
80			return $node->base_uri if $node;
81			return $self->owner_document->base_uri;
82			} # base_uri
83	wakaba	1.1
84	wakaba	1.3	sub child_nodes ($) {
85			require Message::DOM::NodeList;
86			return bless \\($_[0]), 'Message::DOM::NodeList::EmptyNodeList';
87			} # child_nodes
88	wakaba	1.2
89			*node_name = \&target;
90
91	wakaba	1.5	sub node_type () { 7 } # PROCESSING_INSTRUCTION_NODE
92	wakaba	1.2
93			*node_value = \&data;
94	wakaba	1.1
95	wakaba	1.4	*text_content = \&node_value;
96
97	wakaba	1.5	## \|Node\| methods
98
99	wakaba	1.8	sub append_child ($$) {
100			report Message::DOM::DOMException
101			-object => $_[0],
102			-type => 'HIERARCHY_REQUEST_ERR',
103			-subtype => 'CHILD_NODE_TYPE_ERR';
104			} # append_child
105
106	wakaba	1.5	sub manakai_append_text ($$) {
107			## NOTE: Same as \|CharacterData\|'s.
108			if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
109			${$_[0]}->{manakai_read_only}) {
110			report Message::DOM::DOMException
111			-object => $_[0],
112			-type => 'NO_MODIFICATION_ALLOWED_ERR',
113			-subtype => 'READ_ONLY_NODE_ERR';
114			}
115			${$_[0]}->{data} .= ref $_[1] eq 'SCALAR' ? ${$_[1]} : $_[1];
116			} # manakai_append_text
117
118	wakaba	1.8	sub insert_before ($;$) {
119			report Message::DOM::DOMException
120			-object => $_[0],
121			-type => 'HIERARCHY_REQUEST_ERR',
122			-subtype => 'CHILD_NODE_TYPE_ERR';
123			} # insert_before
124
125			sub replace_child ($$) {
126			report Message::DOM::DOMException
127			-object => $_[0],
128			-type => 'HIERARCHY_REQUEST_ERR',
129			-subtype => 'CHILD_NODE_TYPE_ERR';
130			} # replace_child
131
132	wakaba	1.5	## \|ProcessingInstruction\| attributes
133
134			sub manakai_base_uri ($;$);
135
136	wakaba	1.9	sub data ($;$);
137
138			sub target ($);
139
140	wakaba	1.1	package Message::IF::ProcessingInstruction;
141
142			package Message::DOM::Document;
143
144			sub create_processing_instruction ($$$) {
145	wakaba	1.7	if (${$_[0]}->{strict_error_checking}) {
146			my $xv = $_[0]->xml_version;
147			if (defined $xv) {
148			if ($xv eq '1.0' and
149			$_[1] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
150			#
151			} elsif ($xv eq '1.1' and
152			$_[1] =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) {
153			#
154			} else {
155			report Message::DOM::DOMException
156			-object => $_[0],
157			-type => 'INVALID_CHARACTER_ERR',
158			-subtype => 'MALFORMED_NAME_ERR';
159			}
160			}
161			}
162
163	wakaba	1.1	return Message::DOM::ProcessingInstruction->____new (@_[0, 1, 2]);
164			} # create_processing_instruction
165
166	wakaba	1.5	=head1 LICENSE
167
168			Copyright 2007 Wakaba <w@suika.fam.cx>
169
170			This program is free software; you can redistribute it and/or
171			modify it under the same terms as Perl itself.
172
173			=cut
174
175	wakaba	1.1	1;
176	wakaba	1.10	## $Date: 2007/07/08 13:04:37 $