Message/DOM/EntityReference.pm

package Message::DOM::EntityReference;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.6 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::DOM::Node', 'Message::IF::EntityReference';
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,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (boolean, trivial accessors)
    manakai_expanded => 1,
    manakai_external => 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 };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

## |Node| attributes

sub base_uri ($) {
  ## NOTE: Same as |CharacterData|'s.

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

sub node_name ($); # read-only trivial accessor

sub node_type () { 5 } # ENTITY_REFERENCE_NODE

## |EntityReference| attributes

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 $$self->{manakai_entity_base_uri}) {
    return $$self->{manakai_entity_base_uri};
  } else {
    local $Error::Depth = $Error::Depth + 1;
    return $self->base_uri;
  }
} # manakai_entity_base_uri

sub manakai_expanded ($;$);

sub manakai_external ($;$);

package Message::IF::EntityReference;

package Message::DOM::Document;

sub create_entity_reference ($$) {
  our $CreateEntityReference_OpenEntity;
      ## TODO: This is Multithread unsafe

  my $self = $_[0];
  my $orig_strict = $self->strict_error_checking;
  if ($orig_strict) {
    my $xv = $self->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 => $self,
            -type => 'INVALID_CHARACTER_ERR',
            -subtype => 'MALFORMED_NAME_ERR';
      }
    }
  }

  my $r = Message::DOM::EntityReference->____new ($self, $_[1]);

  ## Expansion
  unless ($CreateEntityReference_OpenEntity->{$_[1]}) {
    local $CreateEntityReference_OpenEntity->{$_[1]} = 1;
    local $Error::Depth = $Error::Depth + 1;

    my $doctype = $self->doctype;
    unless ($doctype) {
      $r->manakai_set_read_only (1, 1);
      return $r;
    }

    my $ent = $doctype->get_general_entity_node ($_[1]);
    unless ($ent) {
      $r->manakai_set_read_only (1, 1);
      return $r;
    }

    $self->strict_error_checking (0);
    for my $c (@{$ent->child_nodes}) {
      my $clone = $c->clone_node (1);
      $r->append_child ($clone);
    }
    $r->manakai_expanded ($ent->has_replacement_tree);
    $self->strict_error_checking ($orig_strict);
  }
  $r->manakai_set_read_only (1, 1);
  return $r;
} # create_entity_reference

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