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

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

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

revision 1.6 by wakaba, Sun Jun 17 13:37:40 2007 UTC revision 1.7 by wakaba, Sat Jul 7 09:11:05 2007 UTC
# Line 176  package Message::IF::Attr; Line 176  package Message::IF::Attr;
176  package Message::DOM::Document;  package Message::DOM::Document;
177    
178  sub create_attribute ($$) {  sub create_attribute ($$) {
179      if (${$_[0]}->{strict_error_checking}) {
180        my $xv = $_[0]->xml_version;
181        ## TODO: HTML Document ??
182        if (defined $xv) {
183          if ($xv eq '1.0' and
184              $_[1] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
185            #
186          } elsif ($xv eq '1.1' and
187                   $_[1] =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) {
188            #
189          } else {
190            report Message::DOM::DOMException
191                -object => $_[0],
192                -type => 'INVALID_CHARACTER_ERR',
193                -subtype => 'MALFORMED_NAME_ERR';
194          }
195        }
196      }
197    ## TODO: HTML5    ## TODO: HTML5
198    return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);    return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);
199  } # create_attribute  } # create_attribute
# Line 188  sub create_attribute_ns ($$$) { Line 206  sub create_attribute_ns ($$$) {
206      ($prefix, $lname) = split /:/, $_[2], 2;      ($prefix, $lname) = split /:/, $_[2], 2;
207      ($prefix, $lname) = (undef, $prefix) unless defined $lname;      ($prefix, $lname) = (undef, $prefix) unless defined $lname;
208    }    }
209    
210      if (${$_[0]}->{strict_error_checking}) {
211        my $xv = $_[0]->xml_version;
212        ## TODO: HTML Document ?? (NOT_SUPPORTED_ERR is different from what Web browsers do)
213        if (defined $xv) {
214          if ($xv eq '1.0') {
215            if (ref $_[2] eq 'ARRAY' or
216                $_[2] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
217              if (defined $prefix) {
218                if ($prefix =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) {
219                  #
220                } else {
221                  report Message::DOM::DOMException
222                      -object => $_[0],
223                      -type => 'NAMESPACE_ERR',
224                      -subtype => 'MALFORMED_QNAME_ERR';
225                }
226              }
227              if ($lname =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) {
228                #
229              } else {
230                report Message::DOM::DOMException
231                    -object => $_[0],
232                    -type => 'NAMESPACE_ERR',
233                    -subtype => 'MALFORMED_QNAME_ERR';
234              }
235            } else {
236              report Message::DOM::DOMException
237                  -object => $_[0],
238                  -type => 'INVALID_CHARACTER_ERR',
239                  -subtype => 'MALFORMED_NAME_ERR';
240            }
241          } elsif ($xv eq '1.1') {
242            if (ref $_[2] eq 'ARRAY' or
243                $_[2] =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) {
244              if (defined $prefix) {
245                if ($prefix =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*\z/) {
246                  #
247                } else {
248                  report Message::DOM::DOMException
249                      -object => $_[0],
250                      -type => 'NAMESPACE_ERR',
251                      -subtype => 'MALFORMED_QNAME_ERR';
252                }
253              }
254              if ($lname =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*\z/) {
255                #
256              } else {
257                report Message::DOM::DOMException
258                    -object => $_[0],
259                    -type => 'NAMESPACE_ERR',
260                    -subtype => 'MALFORMED_QNAME_ERR';
261              }
262            } else {
263              report Message::DOM::DOMException
264                  -object => $_[0],
265                  -type => 'INVALID_CHARACTER_ERR',
266                  -subtype => 'MALFORMED_NAME_ERR';
267            }
268          } else {
269            die "create_attribute_ns: XML version |$xv| is not supported";
270          }
271        }
272    
273        if (defined $prefix) {
274          if (not defined $_[1]) {
275            report Message::DOM::DOMException
276                -object => $_[0],
277                -type => 'NAMESPACE_ERR',
278                -subtype => 'PREFIXED_NULLNS_ERR';
279          } elsif ($prefix eq 'xml' and
280                   $_[1] ne q<http://www.w3.org/XML/1998/namespace>) {
281            report Message::DOM::DOMException
282                -object => $_[0],
283                -type => 'NAMESPACE_ERR',
284                -subtype => 'XMLPREFIX_NONXMLNS_ERR';
285          } elsif ($prefix eq 'xmlns' and
286                   $_[1] ne q<http://www.w3.org/2000/xmlns/>) {
287            report Message::DOM::DOMException
288                -object => $_[0],
289                -type => 'NAMESPACE_ERR',
290                -subtype => 'XMLNSPREFIX_NONXMLNSNS_ERR';
291          } elsif ($_[1] eq q<http://www.w3.org/2000/xmlns/> and
292                   $prefix ne 'xmlns') {
293            report Message::DOM::DOMException
294                -object => $_[0],
295                -type => 'NAMESPACE_ERR',
296                -subtype => 'NONXMLNSPREFIX_XMLNSNS_ERR';
297          }
298        } else { # no prefix
299          if ($lname eq 'xmlns' and
300              (not defined $_[1] or $_[1] ne q<http://www.w3.org/2000/xmlns/>)) {
301            report Message::DOM::DOMException
302                -object => $_[0],
303                -type => 'NAMESPACE_ERR',
304                -subtype => 'XMLNS_NONXMLNSNS_ERR';
305          } elsif (not defined $_[1]) {
306            #
307          } elsif ($_[1] eq q<http://www.w3.org/2000/xmlns/> and
308                   $lname ne 'xmlns') {
309            report Message::DOM::DOMException
310                -object => $_[0],
311                -type => 'NAMESPACE_ERR',
312                -subtype => 'NONXMLNSPREFIX_XMLNSNS_ERR';
313          }
314        }
315      }
316    
317      ## TODO: Older version of manakai set |attribute_type|
318      ## attribute for |xml:id| attribute.  Should we support this?
319    
320    return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);    return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);
321  } # create_element_ns  } # create_attribute_ns
322    
323    =head1 LICENSE
324    
325    Copyright 2007 Wakaba <w@suika.fam.cx>
326    
327    This program is free software; you can redistribute it and/or
328    modify it under the same terms as Perl itself.
329    
330    =cut
331    
332  1;  1;
 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>  
333  ## $Date$  ## $Date$
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24