Message/DOM/Entity.pm

package Message::DOM::Entity;
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::Entity';
require Message::DOM::Node;

sub ____new ($$$) {
  my $self = shift->SUPER::____new (shift);
  $$self->{node_name} = $_[0];
  $$self->{child_nodes} = [];
  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)
    node_name => 1,
    owner_document_type_definition => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (boolean, trivial accessors)
    has_replacement_tree => 1,
    manakai_has_bom => 1,
    is_externally_declared => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$;\$) {
        if (\@_ > 1) {
          if (\${\${\$_[0]}->{owner_document}}->{manakai_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 (\$_[1]) {
            \${\$_[0]}->{$method_name} = 1;
          } else {
            delete \${\$_[0]}->{$method_name};
          }
        }
        return \${\$_[0]}->{$method_name};
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (DOMString, trivial accessors)
    manakai_charset => 1,
    input_encoding => 1,
    notation_name => 1,
    public_id => 1,
    system_id => 1,
    xml_encoding => 1,
    xml_version => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$;\$) {
        if (\@_ > 1) {
          if (\${\$_[0]}->{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 node_name ($); # read-only trivial accessor

sub node_type () { 6 } # ENTITY_NODE

## |Entity| attributes

## TODO: documentation
sub manakai_charset ($;$);

sub manakai_declaration_base_uri ($;$) {
  ## NOTE: Same as |Notation|'s.

  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]}->{manakai_declaration_base_uri} = ''.$_[1];
    } else {
      delete ${$_[0]}->{manakai_declaration_base_uri};
    }
  }
  
  if (defined wantarray) {
    if (defined ${$_[0]}->{manakai_declaration_base_uri}) {
      return ${$_[0]}->{manakai_declaration_base_uri};
    } else {
      local $Error::Depth = $Error::Depth + 1;
      return $_[0]->base_uri;
    }  
  }
} # manakai_declaration_base_uri

sub manakai_entity_base_uri ($;$) {
  my $self = $_[0];
  if (@_ > 1) {
    if (${$$self->{owner_document}}->{strict_error_checking}) {
      if ($$self->{manakai_read_only}) {
        report Message::DOM::DOMException
            -object => $self,
            -type => 'NO_MODIFICATION_ALLOWED_ERR',
            -subtype => 'READ_ONLY_NODE_ERR';
      }
    }
    if (defined $_[1]) {
      $$self->{manakai_entity_base_uri} = ''.$_[1];
    } else {
      delete $$self->{manakai_entity_base_uri};
    }
  }

  if (defined wantarray) {
    if (defined $$self->{manakai_entity_base_uri}) {
      return $$self->{manakai_entity_base_uri};
    } else {
      local $Error::Depth = $Error::Depth + 1;
      my $v = $self->manakai_entity_uri;
      return $v if defined $v;
      return $self->base_uri;
    }
  }
} # manakai_entity_base_uri

sub manakai_entity_uri ($;$) {
  my $self = $_[0];
  if (@_ > 1) {
    if (${$$self->{owner_document}}->{strict_error_checking}) {
      if ($$self->{manakai_read_only}) {
        report Message::DOM::DOMException
            -object => $self,
            -type => 'NO_MODIFICATION_ALLOWED_ERR',
            -subtype => 'READ_ONLY_NODE_ERR';
      }
    }
    if (defined $_[1]) {
      $$self->{manakai_entity_uri} = ''.$_[1];
    } else {
      delete $$self->{manakai_entity_uri};
    }
  }

  if (defined wantarray) {
    return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};

    local $Error::Depth = $Error::Depth + 1;
    my $v = $$self->{system_id};
    if (defined $v) {
      $v = ${$$self->{owner_document}}->{implementation}->create_uri_reference
        ($v);
      if (not defined $v->uri_scheme) {
        my $base = $self->manakai_declaration_base_uri;
        return $v->get_absolute_reference ($base)->uri_reference
            if defined $base;
      }
      return $v->uri_reference;
    } else {
      return undef;
    }
  }
} # manakai_entity_uri

## TODO: documentation
sub manakai_has_bom ($;$);

## NOTE: A manakai extension
sub has_replacement_tree ($;$);

## NOTE: Setter is a manakai extension.
## TODO: Document it.
sub input_encoding ($;$);

## NOTE: A manakai extension.
sub is_externally_declared ($;$);

## NOTE: Setter is a manakai extension.
sub notation_name ($;$);

## NOTE: A manakai extension.
sub owner_document_type_definition ($);

## NOTE: Setter is a manakai extension.
sub public_id ($;$);

## NOTE: Setter is a manakai extension.
sub system_id ($;$);

## NOTE: Setter is a manakai extension.
sub xml_encoding ($;$);

## NOTE: Setter is a manakai extension.
## TODO: Document it. ## TODO: e.g. xml_version = '3.7'
## TODO: Spec does not mention |null| case
## TODO: Should we provide default?
sub xml_version ($;$);

package Message::IF::Entity;

package Message::DOM::Document;

sub create_general_entity ($$) {
  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::Entity->____new (@_[0, 1]);
} # create_general_entity

=head1 LICENSE

Copyright 2007 Wakaba <[email protected]>

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

=cut

1;
## $Date: 2007/11/18 11:08:41 $
1	package Message::DOM::Entity;
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::Entity';
5	require Message::DOM::Node;
6
7	sub ____new ($$$) {
8	my $self = shift->SUPER::____new (shift);
9	$$self->{node_name} = $_[0];
10	$$self->{child_nodes} = [];
11	return $self;
12	} # ____new
13
14	sub AUTOLOAD {
15	my $method_name = our $AUTOLOAD;
16	$method_name =~ s/.*:://;
17	return if $method_name eq 'DESTROY';
18
19	if ({
20	## Read-only attributes (trivial accessors)
21	node_name => 1,
22	owner_document_type_definition => 1,
23	}->{$method_name}) {
24	no strict 'refs';
25	eval qq{
26	sub $method_name (\$) {
27	return \${\$_[0]}->{$method_name};
28	}
29	};
30	goto &{ $AUTOLOAD };
31	} elsif ({
32	## Read-write attributes (boolean, trivial accessors)
33	has_replacement_tree => 1,
34	manakai_has_bom => 1,
35	is_externally_declared => 1,
36	}->{$method_name}) {
37	no strict 'refs';
38	eval qq{
39	sub $method_name (\$;\$) {
40	if (\@_ > 1) {
41	if (\${\${\$_[0]}->{owner_document}}->{manakai_strict_error_checking} and
42	\${\$_[0]}->{manakai_read_only}) {
43	report Message::DOM::DOMException
44	-object => \$_[0],
45	-type => 'NO_MODIFICATION_ALLOWED_ERR',
46	-subtype => 'READ_ONLY_NODE_ERR';
47	}
48	if (\$_[1]) {
49	\${\$_[0]}->{$method_name} = 1;
50	} else {
51	delete \${\$_[0]}->{$method_name};
52	}
53	}
54	return \${\$_[0]}->{$method_name};
55	}
56	};
57	goto &{ $AUTOLOAD };
58	} elsif ({
59	## Read-write attributes (DOMString, trivial accessors)
60	manakai_charset => 1,
61	input_encoding => 1,
62	notation_name => 1,
63	public_id => 1,
64	system_id => 1,
65	xml_encoding => 1,
66	xml_version => 1,
67	}->{$method_name}) {
68	no strict 'refs';
69	eval qq{
70	sub $method_name (\$;\$) {
71	if (\@_ > 1) {
72	if (\${\$_[0]}->{strict_error_checking} and
73	\${\$_[0]}->{manakai_read_only}) {
74	report Message::DOM::DOMException
75	-object => \$_[0],
76	-type => 'NO_MODIFICATION_ALLOWED_ERR',
77	-subtype => 'READ_ONLY_NODE_ERR';
78	}
79	if (defined \$_[1]) {
80	\${\$_[0]}->{$method_name} = ''.\$_[1];
81	} else {
82	delete \${\$_[0]}->{$method_name};
83	}
84	}
85	return \${\$_[0]}->{$method_name};
86	}
87	};
88	goto &{ $AUTOLOAD };
89	} else {
90	require Carp;
91	Carp::croak (qq<Can't locate method "$AUTOLOAD">);
92	}
93	} # AUTOLOAD
94
95	## \|Node\| attributes
96
97	sub node_name ($); # read-only trivial accessor
98
99	sub node_type () { 6 } # ENTITY_NODE
100
101	## \|Entity\| attributes
102
103	## TODO: documentation
104	sub manakai_charset ($;$);
105
106	sub manakai_declaration_base_uri ($;$) {
107	## NOTE: Same as \|Notation\|'s.
108
109	if (@_ > 1) {
110	if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
111	${$_[0]}->{manakai_read_only}) {
112	report Message::DOM::DOMException
113	-object => $_[0],
114	-type => 'NO_MODIFICATION_ALLOWED_ERR',
115	-subtype => 'READ_ONLY_NODE_ERR';
116	}
117	if (defined $_[1]) {
118	${$_[0]}->{manakai_declaration_base_uri} = ''.$_[1];
119	} else {
120	delete ${$_[0]}->{manakai_declaration_base_uri};
121	}
122	}
123
124	if (defined wantarray) {
125	if (defined ${$_[0]}->{manakai_declaration_base_uri}) {
126	return ${$_[0]}->{manakai_declaration_base_uri};
127	} else {
128	local $Error::Depth = $Error::Depth + 1;
129	return $_[0]->base_uri;
130	}
131	}
132	} # manakai_declaration_base_uri
133
134	sub manakai_entity_base_uri ($;$) {
135	my $self = $_[0];
136	if (@_ > 1) {
137	if (${$$self->{owner_document}}->{strict_error_checking}) {
138	if ($$self->{manakai_read_only}) {
139	report Message::DOM::DOMException
140	-object => $self,
141	-type => 'NO_MODIFICATION_ALLOWED_ERR',
142	-subtype => 'READ_ONLY_NODE_ERR';
143	}
144	}
145	if (defined $_[1]) {
146	$$self->{manakai_entity_base_uri} = ''.$_[1];
147	} else {
148	delete $$self->{manakai_entity_base_uri};
149	}
150	}
151
152	if (defined wantarray) {
153	if (defined $$self->{manakai_entity_base_uri}) {
154	return $$self->{manakai_entity_base_uri};
155	} else {
156	local $Error::Depth = $Error::Depth + 1;
157	my $v = $self->manakai_entity_uri;
158	return $v if defined $v;
159	return $self->base_uri;
160	}
161	}
162	} # manakai_entity_base_uri
163
164	sub manakai_entity_uri ($;$) {
165	my $self = $_[0];
166	if (@_ > 1) {
167	if (${$$self->{owner_document}}->{strict_error_checking}) {
168	if ($$self->{manakai_read_only}) {
169	report Message::DOM::DOMException
170	-object => $self,
171	-type => 'NO_MODIFICATION_ALLOWED_ERR',
172	-subtype => 'READ_ONLY_NODE_ERR';
173	}
174	}
175	if (defined $_[1]) {
176	$$self->{manakai_entity_uri} = ''.$_[1];
177	} else {
178	delete $$self->{manakai_entity_uri};
179	}
180	}
181
182	if (defined wantarray) {
183	return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};
184
185	local $Error::Depth = $Error::Depth + 1;
186	my $v = $$self->{system_id};
187	if (defined $v) {
188	$v = ${$$self->{owner_document}}->{implementation}->create_uri_reference
189	($v);
190	if (not defined $v->uri_scheme) {
191	my $base = $self->manakai_declaration_base_uri;
192	return $v->get_absolute_reference ($base)->uri_reference
193	if defined $base;
194	}
195	return $v->uri_reference;
196	} else {
197	return undef;
198	}
199	}
200	} # manakai_entity_uri
201
202	## TODO: documentation
203	sub manakai_has_bom ($;$);
204
205	## NOTE: A manakai extension
206	sub has_replacement_tree ($;$);
207
208	## NOTE: Setter is a manakai extension.
209	## TODO: Document it.
210	sub input_encoding ($;$);
211
212	## NOTE: A manakai extension.
213	sub is_externally_declared ($;$);
214
215	## NOTE: Setter is a manakai extension.
216	sub notation_name ($;$);
217
218	## NOTE: A manakai extension.
219	sub owner_document_type_definition ($);
220
221	## NOTE: Setter is a manakai extension.
222	sub public_id ($;$);
223
224	## NOTE: Setter is a manakai extension.
225	sub system_id ($;$);
226
227	## NOTE: Setter is a manakai extension.
228	sub xml_encoding ($;$);
229
230	## NOTE: Setter is a manakai extension.
231	## TODO: Document it. ## TODO: e.g. xml_version = '3.7'
232	## TODO: Spec does not mention \|null\| case
233	## TODO: Should we provide default?
234	sub xml_version ($;$);
235
236	package Message::IF::Entity;
237
238	package Message::DOM::Document;
239
240	sub create_general_entity ($$) {
241	if (${$_[0]}->{strict_error_checking}) {
242	my $xv = $_[0]->xml_version;
243	if (defined $xv) {
244	if ($xv eq '1.0' and
245	$_[1] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
246	#
247	} elsif ($xv eq '1.1' and
248	$_[1] =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) {
249	#
250	} else {
251	report Message::DOM::DOMException
252	-object => $_[0],
253	-type => 'INVALID_CHARACTER_ERR',
254	-subtype => 'MALFORMED_NAME_ERR';
255	}
256	}
257	}
258
259	return Message::DOM::Entity->____new (@_[0, 1]);
260	} # create_general_entity
261
262	=head1 LICENSE
263
264	Copyright 2007 Wakaba <[email protected]>
265
266	This program is free software; you can redistribute it and/or
267	modify it under the same terms as Perl itself.
268
269	=cut
270
271	1;
272	## $Date: 2007/11/18 11:08:41 $