Message/DOM/Entity.pm

package Message::DOM::Entity;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\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 (\$) {
        if (\@_ > 1) {
          require Carp;
          Carp::croak (qq<Can't modify read-only attribute>);
        }
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (boolean, trivial accessors)
    has_replacement_tree => 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)
    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

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

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

## NOTE: Setter is a manakai extension.
## TODO: Document it.
sub is_externally_declared ($;$);
#    @@enDesc:
#      Whether the entity is declared by an external markup declaration,
#      i.e. a markup declaration occuring in the external subset or
#      in a parameter entity.
#    @@Type: boolean
#    @@TrueCase:
#      @@@enDesc:
#        If the entity is declared by an external markup declaration.
#    @@FalseCase:
#      @@@enDesc:
#        If the entity is declared by a markup declaration in
#        the internal subset, or if the <IF::Entity> node
#        is created in memory.

## 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 ($;$);

## |Entity| methods

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

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