Message/DOM/Entity.pm

package Message::DOM::Entity;
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::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: 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/14 16:32:28 $
1	wakaba	1.2	package Message::DOM::Entity;
2	wakaba	1.1	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.2	push our @ISA, 'Message::DOM::Node', 'Message::IF::Entity';
5	wakaba	1.1	require Message::DOM::Node;
6
7			sub ____new ($$$) {
8			my $self = shift->SUPER::____new (shift);
9			$$self->{node_name} = $_[0];
10	wakaba	1.3	$$self->{child_nodes} = [];
11	wakaba	1.1	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	wakaba	1.2	node_name => 1,
22	wakaba	1.7	owner_document_type_definition => 1,
23	wakaba	1.1	}->{$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	wakaba	1.4	## Read-write attributes (boolean, trivial accessors)
33			has_replacement_tree => 1,
34	wakaba	1.10	manakai_has_bom => 1,
35	wakaba	1.6	is_externally_declared => 1,
36	wakaba	1.4	}->{$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	wakaba	1.1	## Read-write attributes (DOMString, trivial accessors)
60	wakaba	1.10	manakai_charset => 1,
61	wakaba	1.6	input_encoding => 1,
62	wakaba	1.5	notation_name => 1,
63	wakaba	1.1	public_id => 1,
64			system_id => 1,
65	wakaba	1.5	xml_encoding => 1,
66	wakaba	1.6	xml_version => 1,
67	wakaba	1.1	}->{$method_name}) {
68			no strict 'refs';
69			eval qq{
70	wakaba	1.4	sub $method_name (\$;\$) {
71	wakaba	1.1	if (\@_ > 1) {
72	wakaba	1.4	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	wakaba	1.1	}
85	wakaba	1.4	return \${\$_[0]}->{$method_name};
86	wakaba	1.1	}
87			};
88			goto &{ $AUTOLOAD };
89			} else {
90			require Carp;
91			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
92			}
93			} # AUTOLOAD
94
95	wakaba	1.4	## \|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	wakaba	1.10	## TODO: documentation
104			sub manakai_charset ($;$);
105
106	wakaba	1.4	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	wakaba	1.1
182	wakaba	1.4	if (defined wantarray) {
183			return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};
184	wakaba	1.2
185	wakaba	1.4	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	wakaba	1.10	## TODO: documentation
203			sub manakai_has_bom ($;$);
204
205	wakaba	1.4	## NOTE: Setter is a manakai extension.
206	wakaba	1.6	## TODO: Document it.
207			sub input_encoding ($;$);
208
209			## NOTE: Setter is a manakai extension.
210			## TODO: Document it.
211			sub is_externally_declared ($;$);
212			# @@enDesc:
213			# Whether the entity is declared by an external markup declaration,
214			# i.e. a markup declaration occuring in the external subset or
215			# in a parameter entity.
216			# @@Type: boolean
217			# @@TrueCase:
218			# @@@enDesc:
219			# If the entity is declared by an external markup declaration.
220			# @@FalseCase:
221			# @@@enDesc:
222			# If the entity is declared by a markup declaration in
223			# the internal subset, or if the <IF::Entity> node
224			# is created in memory.
225
226			## NOTE: Setter is a manakai extension.
227	wakaba	1.5	sub notation_name ($;$);
228
229	wakaba	1.7	## NOTE: A manakai extension.
230			sub owner_document_type_definition ($);
231
232	wakaba	1.5	## NOTE: Setter is a manakai extension.
233	wakaba	1.4	sub public_id ($;$);
234
235			## NOTE: Setter is a manakai extension.
236			sub system_id ($;$);
237	wakaba	1.2
238	wakaba	1.5	## NOTE: Setter is a manakai extension.
239			sub xml_encoding ($;$);
240
241	wakaba	1.6	## NOTE: Setter is a manakai extension.
242			## TODO: Document it. ## TODO: e.g. xml_version = '3.7'
243			## TODO: Spec does not mention \|null\| case
244			## TODO: Should we provide default?
245			sub xml_version ($;$);
246
247	wakaba	1.4	## \|Entity\| methods
248	wakaba	1.2
249	wakaba	1.4	## NOTE: A manakai extension
250			sub has_replacement_tree ($;$);
251	wakaba	1.1
252			package Message::IF::Entity;
253
254			package Message::DOM::Document;
255
256	wakaba	1.2	sub create_general_entity ($$) {
257	wakaba	1.8	if (${$_[0]}->{strict_error_checking}) {
258			my $xv = $_[0]->xml_version;
259			if (defined $xv) {
260			if ($xv eq '1.0' and
261			$_[1] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
262			#
263			} elsif ($xv eq '1.1' and
264			$_[1] =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) {
265			#
266			} else {
267			report Message::DOM::DOMException
268			-object => $_[0],
269			-type => 'INVALID_CHARACTER_ERR',
270			-subtype => 'MALFORMED_NAME_ERR';
271			}
272			}
273			}
274
275	wakaba	1.1	return Message::DOM::Entity->____new (@_[0, 1]);
276			} # create_general_entity
277
278	wakaba	1.4	=head1 LICENSE
279
280			Copyright 2007 Wakaba <w@suika.fam.cx>
281
282			This program is free software; you can redistribute it and/or
283			modify it under the same terms as Perl itself.
284
285			=cut
286
287	wakaba	1.1	1;
288	wakaba	1.10	## $Date: 2007/07/14 16:32:28 $