/[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.9 by wakaba, Sun Jul 8 13:04:36 2007 UTC revision 1.10 by wakaba, Sat Jul 14 06:12:56 2007 UTC
# Line 47  sub base_uri ($) { Line 47  sub base_uri ($) {
47    local $Error::Depth = $Error::Depth + 1;    local $Error::Depth = $Error::Depth + 1;
48    my $oe = $self->owner_element;    my $oe = $self->owner_element;
49    if ($oe) {    if ($oe) {
50      my $ln = $self->local_name;      my $ln = $self->manakai_local_name;
51      my $nsuri = $self->namespace_uri;      my $nsuri = $self->namespace_uri;
52      if (($ln eq 'base' and      if (($ln eq 'base' and
53           defined $nsuri and $nsuri eq 'http://www.w3.org/XML/1998/namespace') or           defined $nsuri and $nsuri eq 'http://www.w3.org/XML/1998/namespace') or
# Line 442  sub manakai_attribute_type ($;$) { Line 442  sub manakai_attribute_type ($;$) {
442    return $$self->{manakai_attribute_type} || 0;    return $$self->{manakai_attribute_type} || 0;
443  } # manakai_attribute_type  } # manakai_attribute_type
444    
445    sub is_id ($;$) {
446      my $self = $_[0];
447    
448      if (@_ > 1) {
449        ## NOTE: The setter is a manakai extension.
450        ## TODO: Document.
451    
452        if (${$$self->{owner_document}}->{strict_error_checking}) {
453          if ($$self->{manakai_read_only}) {
454            report Message::DOM::DOMException
455                  -object => $self,
456                  -type => 'NO_MODIFICATION_ALLOWED_ERR',
457                  -subtype => 'READ_ONLY_NODE_ERR';
458          }
459        }
460    
461        if ($_[1]) {
462          $$self->{manakai_user_determined_id} = 1;
463        } else {
464          delete $$self->{manakai_user_determined_id};
465        }
466      }
467      return unless defined wantarray;
468      
469      ## DTD Attribute Type
470      my $type = $$self->{manakai_attribute_type};
471      if (defined $type and $type == 2) { # ID_ATTR
472        return 1;
473      }
474      
475      ## User-determined ID
476      if ($$self->{manakai_user_determined_id}) {
477        return 1;
478      }
479    
480      ## Application-determined ID
481      my $nsuri = $self->namespace_uri;
482      my $ln = $self->manakai_local_name;
483      if (defined $nsuri) {
484        if ($ln eq 'id') {
485          if ($nsuri eq q<http://www.w3.org/XML/1998/namespace>) {
486            return 1;
487          }
488        }
489      } else {
490        if ($ln eq 'xml:id') {
491          return 1;
492        }
493    
494        my $oe = $$self->{owner_element};
495        if ($oe) {
496          my $oe_nsuri = $oe->namespace_uri;
497          if (defined $oe_nsuri) {
498            if ($ln eq 'id') {
499              if ($oe_nsuri eq q<http://www.w3.org/1999/xhtml>) {
500                return 1;
501              }
502            }
503          }
504        }
505      }
506    
507      return 0;
508    } # is_id
509    
510  ## TODO: HTML5 case stuff?  ## TODO: HTML5 case stuff?
511  sub name ($) {  sub name ($) {
512    my $self = shift;    my $self = shift;
# Line 452  sub name ($) { Line 517  sub name ($) {
517    }    }
518  } # name  } # name
519    
520    ## TODO: Documentation
521    sub manakai_name ($) {
522      my $self = shift;
523      if (defined $$self->{prefix}) {
524        return $$self->{prefix} . ':' . $$self->{local_name};
525      } else {
526        return $$self->{local_name};
527      }
528    } # manakai_name
529    
530    sub schema_type_info ($) {
531      require Message::DOM::TypeInfo;
532      my $v = ${$_[0]}->{manakai_attribute_type} || 0;
533      return bless \$v, 'Message::DOM::TypeInfo';
534    } # schema_type_info
535    
536  sub specified ($;$) {  sub specified ($;$) {
537    if (@_ > 1) {    if (@_ > 1) {
538      ## NOTE: A manakai extension.      ## NOTE: A manakai extension.
# Line 508  sub create_attribute_ns ($$$) { Line 589  sub create_attribute_ns ($$$) {
589      ($prefix, $lname) = split /:/, $_[2], 2;      ($prefix, $lname) = split /:/, $_[2], 2;
590      ($prefix, $lname) = (undef, $prefix) unless defined $lname;      ($prefix, $lname) = (undef, $prefix) unless defined $lname;
591    }    }
592      my $nsuri = defined $_[1] ? $_[1] eq '' ? undef : $_[1] : undef;
593    
594    if (${$_[0]}->{strict_error_checking}) {    if (${$_[0]}->{strict_error_checking}) {
595      my $xv = $_[0]->xml_version;      my $xv = $_[0]->xml_version;
# Line 573  sub create_attribute_ns ($$$) { Line 655  sub create_attribute_ns ($$$) {
655      }      }
656    
657      if (defined $prefix) {      if (defined $prefix) {
658        if (not defined $_[1]) {        if (not defined $nsuri) {
659          report Message::DOM::DOMException          report Message::DOM::DOMException
660              -object => $_[0],              -object => $_[0],
661              -type => 'NAMESPACE_ERR',              -type => 'NAMESPACE_ERR',
662              -subtype => 'PREFIXED_NULLNS_ERR';              -subtype => 'PREFIXED_NULLNS_ERR';
663        } elsif ($prefix eq 'xml' and        } elsif ($prefix eq 'xml' and
664                 $_[1] ne q<http://www.w3.org/XML/1998/namespace>) {                 $nsuri ne q<http://www.w3.org/XML/1998/namespace>) {
665          report Message::DOM::DOMException          report Message::DOM::DOMException
666              -object => $_[0],              -object => $_[0],
667              -type => 'NAMESPACE_ERR',              -type => 'NAMESPACE_ERR',
668              -subtype => 'XMLPREFIX_NONXMLNS_ERR';              -subtype => 'XMLPREFIX_NONXMLNS_ERR';
669        } elsif ($prefix eq 'xmlns' and        } elsif ($prefix eq 'xmlns' and
670                 $_[1] ne q<http://www.w3.org/2000/xmlns/>) {                 $nsuri ne q<http://www.w3.org/2000/xmlns/>) {
671          report Message::DOM::DOMException          report Message::DOM::DOMException
672              -object => $_[0],              -object => $_[0],
673              -type => 'NAMESPACE_ERR',              -type => 'NAMESPACE_ERR',
674              -subtype => 'XMLNSPREFIX_NONXMLNSNS_ERR';              -subtype => 'XMLNSPREFIX_NONXMLNSNS_ERR';
675        } elsif ($_[1] eq q<http://www.w3.org/2000/xmlns/> and        } elsif ($nsuri eq q<http://www.w3.org/2000/xmlns/> and
676                 $prefix ne 'xmlns') {                 $prefix ne 'xmlns') {
677          report Message::DOM::DOMException          report Message::DOM::DOMException
678              -object => $_[0],              -object => $_[0],
# Line 599  sub create_attribute_ns ($$$) { Line 681  sub create_attribute_ns ($$$) {
681        }        }
682      } else { # no prefix      } else { # no prefix
683        if ($lname eq 'xmlns' and        if ($lname eq 'xmlns' and
684            (not defined $_[1] or $_[1] ne q<http://www.w3.org/2000/xmlns/>)) {            (not defined $nsuri or $nsuri ne q<http://www.w3.org/2000/xmlns/>)) {
685          report Message::DOM::DOMException          report Message::DOM::DOMException
686              -object => $_[0],              -object => $_[0],
687              -type => 'NAMESPACE_ERR',              -type => 'NAMESPACE_ERR',
688              -subtype => 'XMLNS_NONXMLNSNS_ERR';              -subtype => 'XMLNS_NONXMLNSNS_ERR';
689        } elsif (not defined $_[1]) {        } elsif (not defined $nsuri) {
690          #          #
691        } elsif ($_[1] eq q<http://www.w3.org/2000/xmlns/> and        } elsif ($nsuri eq q<http://www.w3.org/2000/xmlns/> and
692                 $lname ne 'xmlns') {                 $lname ne 'xmlns') {
693          report Message::DOM::DOMException          report Message::DOM::DOMException
694              -object => $_[0],              -object => $_[0],
# Line 619  sub create_attribute_ns ($$$) { Line 701  sub create_attribute_ns ($$$) {
701    ## TODO: Older version of manakai set |attribute_type|    ## TODO: Older version of manakai set |attribute_type|
702    ## attribute for |xml:id| attribute.  Should we support this?    ## attribute for |xml:id| attribute.  Should we support this?
703    
704    return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);    return Message::DOM::Attr->____new ($_[0], undef, $nsuri, $prefix, $lname);
705  } # create_attribute_ns  } # create_attribute_ns
706    
707  =head1 LICENSE  =head1 LICENSE
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24