/[suikacvs]/messaging/manakai/lib/Message/DOM/Entity.pm
Suika

Diff of /messaging/manakai/lib/Message/DOM/Entity.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Thu Jun 14 13:10:07 2007 UTC revision 1.6 by wakaba, Sun Jul 8 13:04:37 2007 UTC
# Line 1  Line 1 
1  package Message::DOM::Notation;  package Message::DOM::Entity;
2  use strict;  use strict;
3  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4  push our @ISA, 'Message::DOM::Node', 'Message::IF::Notation';  push our @ISA, 'Message::DOM::Node', 'Message::IF::Entity';
5  require Message::DOM::Node;  require Message::DOM::Node;
6    
 ## Spec:  
 ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-527DCFF2>  
   
7  sub ____new ($$$) {  sub ____new ($$$) {
8    my $self = shift->SUPER::____new (shift);    my $self = shift->SUPER::____new (shift);
9    $$self->{node_name} = $_[0];    $$self->{node_name} = $_[0];
10      $$self->{child_nodes} = [];
11    return $self;    return $self;
12  } # ____new  } # ____new
13                            
# Line 20  sub AUTOLOAD { Line 18  sub AUTOLOAD {
18    
19    if ({    if ({
20      ## Read-only attributes (trivial accessors)      ## Read-only attributes (trivial accessors)
21        node_name => 1,
22    }->{$method_name}) {    }->{$method_name}) {
23      no strict 'refs';      no strict 'refs';
24      eval qq{      eval qq{
# Line 33  sub AUTOLOAD { Line 32  sub AUTOLOAD {
32      };      };
33      goto &{ $AUTOLOAD };      goto &{ $AUTOLOAD };
34    } elsif ({    } elsif ({
35        ## Read-write attributes (boolean, trivial accessors)
36        has_replacement_tree => 1,
37        is_externally_declared => 1,
38      }->{$method_name}) {
39        no strict 'refs';
40        eval qq{
41          sub $method_name (\$;\$) {
42            if (\@_ > 1) {
43              if (\${\${\$_[0]}->{owner_document}}->{manakai_strict_error_checking} and
44                  \${\$_[0]}->{manakai_read_only}) {
45                report Message::DOM::DOMException
46                    -object => \$_[0],
47                    -type => 'NO_MODIFICATION_ALLOWED_ERR',
48                    -subtype => 'READ_ONLY_NODE_ERR';
49              }
50              if (\$_[1]) {
51                \${\$_[0]}->{$method_name} = 1;
52              } else {
53                delete \${\$_[0]}->{$method_name};
54              }
55            }
56            return \${\$_[0]}->{$method_name};
57          }
58        };
59        goto &{ $AUTOLOAD };
60      } elsif ({
61      ## Read-write attributes (DOMString, trivial accessors)      ## Read-write attributes (DOMString, trivial accessors)
62        input_encoding => 1,
63        notation_name => 1,
64      public_id => 1,      public_id => 1,
65      system_id => 1,      system_id => 1,
66        xml_encoding => 1,
67        xml_version => 1,
68    }->{$method_name}) {    }->{$method_name}) {
69      no strict 'refs';      no strict 'refs';
70      eval qq{      eval qq{
71        sub $method_name (\$) {        sub $method_name (\$;\$) {
72          if (\@_ > 1) {          if (\@_ > 1) {
73            ## TODO: read-only, undef            if (\${\$_[0]}->{strict_error_checking} and
74            \${\$_[0]}->{$method_name} = ''.$_[1];                \${\$_[0]}->{manakai_read_only}) {
75                report Message::DOM::DOMException
76                    -object => \$_[0],
77                    -type => 'NO_MODIFICATION_ALLOWED_ERR',
78                    -subtype => 'READ_ONLY_NODE_ERR';
79              }
80              if (defined \$_[1]) {
81                \${\$_[0]}->{$method_name} = ''.\$_[1];
82              } else {
83                delete \${\$_[0]}->{$method_name};
84              }
85          }          }
86          return \${\$_[0]}->{$method_name};          return \${\$_[0]}->{$method_name};
87        }        }
88      };      };
89      goto &{ $AUTOLOAD };      goto &{ $AUTOLOAD };
# Line 53  sub AUTOLOAD { Line 92  sub AUTOLOAD {
92      Carp::croak (qq<Can't locate method "$AUTOLOAD">);      Carp::croak (qq<Can't locate method "$AUTOLOAD">);
93    }    }
94  } # AUTOLOAD  } # AUTOLOAD
95    
96    ## |Node| attributes
97    
98    sub node_name ($); # read-only trivial accessor
99    
100    sub node_type () { 6 } # ENTITY_NODE
101    
102    ## |Entity| attributes
103    
104    sub manakai_declaration_base_uri ($;$) {
105      ## NOTE: Same as |Notation|'s.
106    
107      if (@_ > 1) {
108        if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
109            ${$_[0]}->{manakai_read_only}) {
110          report Message::DOM::DOMException
111              -object => $_[0],
112              -type => 'NO_MODIFICATION_ALLOWED_ERR',
113              -subtype => 'READ_ONLY_NODE_ERR';
114        }
115        if (defined $_[1]) {
116          ${$_[0]}->{manakai_declaration_base_uri} = ''.$_[1];
117        } else {
118          delete ${$_[0]}->{manakai_declaration_base_uri};
119        }
120      }
121      
122      if (defined wantarray) {
123        if (defined ${$_[0]}->{manakai_declaration_base_uri}) {
124          return ${$_[0]}->{manakai_declaration_base_uri};
125        } else {
126          local $Error::Depth = $Error::Depth + 1;
127          return $_[0]->base_uri;
128        }  
129      }
130    } # manakai_declaration_base_uri
131    
132    sub manakai_entity_base_uri ($;$) {
133      my $self = $_[0];
134      if (@_ > 1) {
135        if (${$$self->{owner_document}}->{strict_error_checking}) {
136          if ($$self->{manakai_read_only}) {
137            report Message::DOM::DOMException
138                -object => $self,
139                -type => 'NO_MODIFICATION_ALLOWED_ERR',
140                -subtype => 'READ_ONLY_NODE_ERR';
141          }
142        }
143        if (defined $_[1]) {
144          $$self->{manakai_entity_base_uri} = ''.$_[1];
145        } else {
146          delete $$self->{manakai_entity_base_uri};
147        }
148      }
149    
150      if (defined wantarray) {
151        if (defined $$self->{manakai_entity_base_uri}) {
152          return $$self->{manakai_entity_base_uri};
153        } else {
154          local $Error::Depth = $Error::Depth + 1;
155          my $v = $self->manakai_entity_uri;
156          return $v if defined $v;
157          return $self->base_uri;
158        }
159      }
160    } # manakai_entity_base_uri
161    
162    sub manakai_entity_uri ($;$) {
163      my $self = $_[0];
164      if (@_ > 1) {
165        if (${$$self->{owner_document}}->{strict_error_checking}) {
166          if ($$self->{manakai_read_only}) {
167            report Message::DOM::DOMException
168                -object => $self,
169                -type => 'NO_MODIFICATION_ALLOWED_ERR',
170                -subtype => 'READ_ONLY_NODE_ERR';
171          }
172        }
173        if (defined $_[1]) {
174          $$self->{manakai_entity_uri} = ''.$_[1];
175        } else {
176          delete $$self->{manakai_entity_uri};
177        }
178      }
179    
180      if (defined wantarray) {
181        return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};
182    
183        local $Error::Depth = $Error::Depth + 1;
184        my $v = $$self->{system_id};
185        if (defined $v) {
186          $v = ${$$self->{owner_document}}->{implementation}->create_uri_reference
187            ($v);
188          if (not defined $v->uri_scheme) {
189            my $base = $self->manakai_declaration_base_uri;
190            return $v->get_absolute_reference ($base)->uri_reference
191                if defined $base;
192          }
193          return $v->uri_reference;
194        } else {
195          return undef;
196        }
197      }
198    } # manakai_entity_uri
199    
200    ## NOTE: Setter is a manakai extension.
201    ## TODO: Document it.
202    sub input_encoding ($;$);
203    
204    ## NOTE: Setter is a manakai extension.
205    ## TODO: Document it.
206    sub is_externally_declared ($;$);
207    #    @@enDesc:
208    #      Whether the entity is declared by an external markup declaration,
209    #      i.e. a markup declaration occuring in the external subset or
210    #      in a parameter entity.
211    #    @@Type: boolean
212    #    @@TrueCase:
213    #      @@@enDesc:
214    #        If the entity is declared by an external markup declaration.
215    #    @@FalseCase:
216    #      @@@enDesc:
217    #        If the entity is declared by a markup declaration in
218    #        the internal subset, or if the <IF::Entity> node
219    #        is created in memory.
220    
221    ## NOTE: Setter is a manakai extension.
222    sub notation_name ($;$);
223    
224    ## NOTE: Setter is a manakai extension.
225  sub public_id ($;$);  sub public_id ($;$);
226    
227    ## NOTE: Setter is a manakai extension.
228  sub system_id ($;$);  sub system_id ($;$);
229    
230  ## The |Node| interface - attribute  ## NOTE: Setter is a manakai extension.
231    sub xml_encoding ($;$);
232    
233    ## NOTE: Setter is a manakai extension.
234    ## TODO: Document it. ## TODO: e.g. xml_version = '3.7'
235    ## TODO: Spec does not mention |null| case
236    ## TODO: Should we provide default?
237    sub xml_version ($;$);
238    
239    ## |Entity| methods
240    
241  sub node_type { 6 } # ENTITY_NODE  ## NOTE: A manakai extension
242    sub has_replacement_tree ($;$);
243    
244  package Message::IF::Entity;  package Message::IF::Entity;
245    
246  package Message::DOM::Document;  package Message::DOM::Document;
247    
248  ## Spec:  sub create_general_entity ($$) {
 ## <http://suika.fam.cx/gate/2005/sw/DocumentXDoctype>  
   
 sub create_general_entity ($$$) {  
249    return Message::DOM::Entity->____new (@_[0, 1]);    return Message::DOM::Entity->____new (@_[0, 1]);
250  } # create_general_entity  } # create_general_entity
251    
252    =head1 LICENSE
253    
254    Copyright 2007 Wakaba <[email protected]>
255    
256    This program is free software; you can redistribute it and/or
257    modify it under the same terms as Perl itself.
258    
259    =cut
260    
261  1;  1;
 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>  
262  ## $Date$  ## $Date$
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24