Message/DOM/Attr.pm

package Message::DOM::Attr;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::DOM::Node', 'Message::IF::Attr';
require Message::DOM::Node;

sub ____new ($$$$$$) {
  my $self = shift->SUPER::____new (shift);
  ($$self->{owner_element},
   $$self->{namespace_uri},
   $$self->{prefix},
   $$self->{local_name}) = @_;
  Scalar::Util::weaken ($$self->{owner_element});
  $$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)
    namespace_uri => 1,
    owner_element => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (DOMString, trivial accessors)
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$;\$) {
        if (\@_ > 1) {
          if (\${\$_[0]}->{manakai_read_only}) {
            report Message::DOM::DOMException
                -object => \$_[0],
                -type => 'NO_MODIFICATION_ALLOWED_ERR',
                -subtype => 'READ_ONLY_NODE_ERR';
          }
          if (defined \$_[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
sub owner_element ($);

## The |Node| interface - attribute

sub local_name ($) {
  ## TODO: HTML5
  return ${+shift}->{local_name};
} # local_name

sub manakai_local_name ($) {
  return ${+shift}->{local_name};
} # manakai_local_name

sub namespace_uri ($);

## The name of the attribute [DOM1, DOM2].
## Same as |Attr.name| [DOM3].

*node_name = \&name;

sub node_type () { 2 } # ATTRIBUTE_NODE

## The value of the attribute [DOM1, DOM2].
## Same as |Attr.value| [DOM3].

*node_value = \&value;

sub prefix ($;$) {
  ## NOTE: No check for new value as Firefox doesn't do.
  ## See <http://suika.fam.cx/gate/2005/sw/prefix>.

  ## NOTE: Same as trivial setter except "" -> undef

  ## NOTE: Same as |Element|'s |prefix|.
  
  if (@_ > 1) {
    if (${$_[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }
    if (defined $_[1] and $_[1] ne '') {
      ${$_[0]}->{prefix} = ''.$_[1];
    } else {
      delete ${$_[0]}->{prefix};
    }
  }
  return ${$_[0]}->{prefix}; 
} # prefix

## The |Attr| interface - attribute

## TODO: HTML5 case stuff?
sub name ($) {
  my $self = shift;
  if (defined $$self->{prefix}) {
    return $$self->{prefix} . ':' . $$self->{local_name};
  } else {
    return $$self->{local_name};
  }
} # name

sub value ($;$) {
  if (@_ > 1) {
    ${$_[0]}->{value} = $_[1];
  }
  return ${$_[0]}->{value};
} # value

package Message::IF::Attr;

package Message::DOM::Document;

sub create_attribute ($$) {
  ## TODO: HTML5
  return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);
} # create_attribute

sub create_attribute_ns ($$$) {
  my ($prefix, $lname);
  if (ref $_[2] eq 'ARRAY') {
    ($prefix, $lname) = @{$_[2]};
  } else {
    ($prefix, $lname) = split /:/, $_[2], 2;
    ($prefix, $lname) = (undef, $prefix) unless defined $lname;
  }
  return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);
} # create_element_ns

1;
## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
## $Date: 2007/06/16 08:05:48 $
1	wakaba	1.1	package Message::DOM::Attr;
2			use strict;
3	wakaba	1.5	our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.1	push our @ISA, 'Message::DOM::Node', 'Message::IF::Attr';
5			require Message::DOM::Node;
6
7			sub ____new ($$$$$$) {
8			my $self = shift->SUPER::____new (shift);
9			($$self->{owner_element},
10			$$self->{namespace_uri},
11			$$self->{prefix},
12			$$self->{local_name}) = @_;
13			Scalar::Util::weaken ($$self->{owner_element});
14	wakaba	1.4	$$self->{child_nodes} = [];
15	wakaba	1.1	return $self;
16			} # ____new
17
18			sub AUTOLOAD {
19			my $method_name = our $AUTOLOAD;
20			$method_name =~ s/.*:://;
21			return if $method_name eq 'DESTROY';
22
23			if ({
24			## Read-only attributes (trivial accessors)
25	wakaba	1.3	namespace_uri => 1,
26	wakaba	1.1	owner_element => 1,
27			}->{$method_name}) {
28			no strict 'refs';
29			eval qq{
30			sub $method_name (\$) {
31			return \${\$_[0]}->{$method_name};
32			}
33			};
34			goto &{ $AUTOLOAD };
35			} elsif ({
36			## Read-write attributes (DOMString, trivial accessors)
37			}->{$method_name}) {
38			no strict 'refs';
39			eval qq{
40	wakaba	1.5	sub $method_name (\$;\$) {
41	wakaba	1.1	if (\@_ > 1) {
42	wakaba	1.5	if (\${\$_[0]}->{manakai_read_only}) {
43			report Message::DOM::DOMException
44			-object => \$_[0],
45			-type => 'NO_MODIFICATION_ALLOWED_ERR',
46			-subtype => 'READ_ONLY_NODE_ERR';
47			}
48			if (defined \$_[1]) {
49			\${\$_[0]}->{$method_name} = ''.\$_[1];
50			} else {
51			delete \${\$_[0]}->{$method_name};
52			}
53	wakaba	1.1	}
54			return \${\$_[0]}->{$method_name};
55			}
56			};
57			goto &{ $AUTOLOAD };
58			} else {
59			require Carp;
60			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
61			}
62			} # AUTOLOAD
63			sub owner_element ($);
64
65			## The \|Node\| interface - attribute
66
67	wakaba	1.3	sub local_name ($) {
68			## TODO: HTML5
69			return ${+shift}->{local_name};
70			} # local_name
71
72			sub manakai_local_name ($) {
73			return ${+shift}->{local_name};
74			} # manakai_local_name
75
76			sub namespace_uri ($);
77	wakaba	1.2
78			## The name of the attribute [DOM1, DOM2].
79			## Same as \|Attr.name\| [DOM3].
80
81			*node_name = \&name;
82
83			sub node_type () { 2 } # ATTRIBUTE_NODE
84
85			## The value of the attribute [DOM1, DOM2].
86			## Same as \|Attr.value\| [DOM3].
87
88			*node_value = \&value;
89	wakaba	1.1
90	wakaba	1.3	sub prefix ($;$) {
91	wakaba	1.5	## NOTE: No check for new value as Firefox doesn't do.
92			## See <http://suika.fam.cx/gate/2005/sw/prefix>.
93
94			## NOTE: Same as trivial setter except "" -> undef
95
96			## NOTE: Same as \|Element\|'s \|prefix\|.
97
98			if (@_ > 1) {
99			if (${$_[0]}->{manakai_read_only}) {
100			report Message::DOM::DOMException
101			-object => $_[0],
102			-type => 'NO_MODIFICATION_ALLOWED_ERR',
103			-subtype => 'READ_ONLY_NODE_ERR';
104			}
105			if (defined $_[1] and $_[1] ne '') {
106			${$_[0]}->{prefix} = ''.$_[1];
107			} else {
108			delete ${$_[0]}->{prefix};
109			}
110			}
111			return ${$_[0]}->{prefix};
112	wakaba	1.3	} # prefix
113
114	wakaba	1.1	## The \|Attr\| interface - attribute
115
116			## TODO: HTML5 case stuff?
117			sub name ($) {
118			my $self = shift;
119			if (defined $$self->{prefix}) {
120			return $$self->{prefix} . ':' . $$self->{local_name};
121			} else {
122			return $$self->{local_name};
123			}
124			} # name
125
126			sub value ($;$) {
127			if (@_ > 1) {
128			${$_[0]}->{value} = $_[1];
129			}
130			return ${$_[0]}->{value};
131			} # value
132
133			package Message::IF::Attr;
134
135			package Message::DOM::Document;
136
137			sub create_attribute ($$) {
138			## TODO: HTML5
139			return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);
140			} # create_attribute
141
142			sub create_attribute_ns ($$$) {
143			my ($prefix, $lname);
144			if (ref $_[2] eq 'ARRAY') {
145			($prefix, $lname) = @{$_[2]};
146			} else {
147			($prefix, $lname) = split /:/, $_[2], 2;
148			($prefix, $lname) = (undef, $prefix) unless defined $lname;
149			}
150			return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);
151			} # create_element_ns
152
153			1;
154			## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
155	wakaba	1.5	## $Date: 2007/06/16 08:05:48 $