Message/DOM/ProcessingInstruction.pm

package Message::DOM::ProcessingInstruction;
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::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,
  }->{$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 ($;$) {
  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} = '';
    }
  }

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