/[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.3 by wakaba, Sat Jun 16 08:05:48 2007 UTC revision 1.4 by wakaba, Sun Jun 17 13:37:40 2007 UTC
# Line 4  our $VERSION=do{my @r=(q$Revision$=~/\d+ Line 4  our $VERSION=do{my @r=(q$Revision$=~/\d+
4  push our @ISA, 'Message::DOM::Node', 'Message::IF::Entity';  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];
# Line 35  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      }->{$method_name}) {
38        no strict 'refs';
39        eval qq{
40          sub $method_name (\$;\$) {
41            if (\@_ > 1) {
42              if (\${\${\$_[0]}->{owner_document}}->{manakai_strict_error_checking} and
43                  \${\$_[0]}->{manakai_read_only}) {
44                report Message::DOM::DOMException
45                    -object => \$_[0],
46                    -type => 'NO_MODIFICATION_ALLOWED_ERR',
47                    -subtype => 'READ_ONLY_NODE_ERR';
48              }
49              if (\$_[1]) {
50                \${\$_[0]}->{$method_name} = 1;
51              } else {
52                delete \${\$_[0]}->{$method_name};
53              }
54            }
55            return \${\$_[0]}->{$method_name};
56          }
57        };
58        goto &{ $AUTOLOAD };
59      } elsif ({
60      ## Read-write attributes (DOMString, trivial accessors)      ## Read-write attributes (DOMString, trivial accessors)
61      public_id => 1,      public_id => 1,
62      system_id => 1,      system_id => 1,
63    }->{$method_name}) {    }->{$method_name}) {
64      no strict 'refs';      no strict 'refs';
65      eval qq{      eval qq{
66        sub $method_name (\$) {        sub $method_name (\$;\$) {
67          if (\@_ > 1) {          if (\@_ > 1) {
68            ## TODO: read-only, undef            if (\${\$_[0]}->{strict_error_checking} and
69            \${\$_[0]}->{$method_name} = ''.$_[1];                \${\$_[0]}->{manakai_read_only}) {
70                report Message::DOM::DOMException
71                    -object => \$_[0],
72                    -type => 'NO_MODIFICATION_ALLOWED_ERR',
73                    -subtype => 'READ_ONLY_NODE_ERR';
74              }
75              if (defined \$_[1]) {
76                \${\$_[0]}->{$method_name} = ''.\$_[1];
77              } else {
78                delete \${\$_[0]}->{$method_name};
79              }
80          }          }
81          return \${\$_[0]}->{$method_name};          return \${\$_[0]}->{$method_name};
82        }        }
83      };      };
84      goto &{ $AUTOLOAD };      goto &{ $AUTOLOAD };
# Line 55  sub AUTOLOAD { Line 87  sub AUTOLOAD {
87      Carp::croak (qq<Can't locate method "$AUTOLOAD">);      Carp::croak (qq<Can't locate method "$AUTOLOAD">);
88    }    }
89  } # AUTOLOAD  } # AUTOLOAD
 sub public_id ($;$);  
 sub system_id ($;$);  
90    
91  ## The |Node| interface - attribute  ## |Node| attributes
   
 ## Spec:  
 ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-F68D095>  
 ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-1950641247>  
92    
93  sub node_name ($); # read-only trivial accessor  sub node_name ($); # read-only trivial accessor
94    
95  ## Spec:  sub node_type () { 6 } # ENTITY_NODE
96  ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-111237558>  
97    ## |Entity| attributes
98    
99    sub manakai_declaration_base_uri ($;$) {
100      ## NOTE: Same as |Notation|'s.
101    
102      if (@_ > 1) {
103        if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
104            ${$_[0]}->{manakai_read_only}) {
105          report Message::DOM::DOMException
106              -object => $_[0],
107              -type => 'NO_MODIFICATION_ALLOWED_ERR',
108              -subtype => 'READ_ONLY_NODE_ERR';
109        }
110        if (defined $_[1]) {
111          ${$_[0]}->{manakai_declaration_base_uri} = ''.$_[1];
112        } else {
113          delete ${$_[0]}->{manakai_declaration_base_uri};
114        }
115      }
116      
117      if (defined wantarray) {
118        if (defined ${$_[0]}->{manakai_declaration_base_uri}) {
119          return ${$_[0]}->{manakai_declaration_base_uri};
120        } else {
121          local $Error::Depth = $Error::Depth + 1;
122          return $_[0]->base_uri;
123        }  
124      }
125    } # manakai_declaration_base_uri
126    
127    sub manakai_entity_base_uri ($;$) {
128      my $self = $_[0];
129      if (@_ > 1) {
130        if (${$$self->{owner_document}}->{strict_error_checking}) {
131          if ($$self->{manakai_read_only}) {
132            report Message::DOM::DOMException
133                -object => $self,
134                -type => 'NO_MODIFICATION_ALLOWED_ERR',
135                -subtype => 'READ_ONLY_NODE_ERR';
136          }
137        }
138        if (defined $_[1]) {
139          $$self->{manakai_entity_base_uri} = ''.$_[1];
140        } else {
141          delete $$self->{manakai_entity_base_uri};
142        }
143      }
144    
145      if (defined wantarray) {
146        if (defined $$self->{manakai_entity_base_uri}) {
147          return $$self->{manakai_entity_base_uri};
148        } else {
149          local $Error::Depth = $Error::Depth + 1;
150          my $v = $self->manakai_entity_uri;
151          return $v if defined $v;
152          return $self->base_uri;
153        }
154      }
155    } # manakai_entity_base_uri
156    
157  sub node_type ($) { 6 } # ENTITY_NODE  sub manakai_entity_uri ($;$) {
158      my $self = $_[0];
159      if (@_ > 1) {
160        if (${$$self->{owner_document}}->{strict_error_checking}) {
161          if ($$self->{manakai_read_only}) {
162            report Message::DOM::DOMException
163                -object => $self,
164                -type => 'NO_MODIFICATION_ALLOWED_ERR',
165                -subtype => 'READ_ONLY_NODE_ERR';
166          }
167        }
168        if (defined $_[1]) {
169          $$self->{manakai_entity_uri} = ''.$_[1];
170        } else {
171          delete $$self->{manakai_entity_uri};
172        }
173      }
174    
175      if (defined wantarray) {
176        return $$self->{manakai_entity_uri} if defined $$self->{manakai_entity_uri};
177    
178        local $Error::Depth = $Error::Depth + 1;
179        my $v = $$self->{system_id};
180        if (defined $v) {
181          $v = ${$$self->{owner_document}}->{implementation}->create_uri_reference
182            ($v);
183          if (not defined $v->uri_scheme) {
184            my $base = $self->manakai_declaration_base_uri;
185            return $v->get_absolute_reference ($base)->uri_reference
186                if defined $base;
187          }
188          return $v->uri_reference;
189        } else {
190          return undef;
191        }
192      }
193    } # manakai_entity_uri
194    
195    ## NOTE: Setter is a manakai extension.
196    sub public_id ($;$);
197    
198    ## NOTE: Setter is a manakai extension.
199    sub system_id ($;$);
200    
201    ## |Entity| methods
202    
203    ## NOTE: A manakai extension
204    sub has_replacement_tree ($;$);
205    
206  package Message::IF::Entity;  package Message::IF::Entity;
207    
208  package Message::DOM::Document;  package Message::DOM::Document;
209    
 ## Spec:  
 ## <http://suika.fam.cx/gate/2005/sw/DocumentXDoctype>  
   
210  sub create_general_entity ($$) {  sub create_general_entity ($$) {
211    return Message::DOM::Entity->____new (@_[0, 1]);    return Message::DOM::Entity->____new (@_[0, 1]);
212  } # create_general_entity  } # create_general_entity
213    
214    =head1 LICENSE
215    
216    Copyright 2007 Wakaba <w@suika.fam.cx>
217    
218    This program is free software; you can redistribute it and/or
219    modify it under the same terms as Perl itself.
220    
221    =cut
222    
223  1;  1;
 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>  
224  ## $Date$  ## $Date$
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24