Message/DOM/Attr.pm

package Message::DOM::Attr;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.2 $=~/\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});
  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) {
          \${\$_[0]}->{$method_name} = ''.\$_[1];
        }
        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 ($;$) {
  ## TODO: setter
  return ${+shift}->{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/15 14:32:49 $
1	wakaba	1.1	package Message::DOM::Attr;
2			use strict;
3	wakaba	1.3	our $VERSION=do{my @r=(q$Revision: 1.2 $=~/\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			return $self;
15			} # ____new
16
17			sub AUTOLOAD {
18			my $method_name = our $AUTOLOAD;
19			$method_name =~ s/.*:://;
20			return if $method_name eq 'DESTROY';
21
22			if ({
23			## Read-only attributes (trivial accessors)
24	wakaba	1.3	namespace_uri => 1,
25	wakaba	1.1	owner_element => 1,
26			}->{$method_name}) {
27			no strict 'refs';
28			eval qq{
29			sub $method_name (\$) {
30			return \${\$_[0]}->{$method_name};
31			}
32			};
33			goto &{ $AUTOLOAD };
34			} elsif ({
35			## Read-write attributes (DOMString, trivial accessors)
36			}->{$method_name}) {
37			no strict 'refs';
38			eval qq{
39			sub $method_name (\$) {
40			if (\@_ > 1) {
41	wakaba	1.3	\${\$_[0]}->{$method_name} = ''.\$_[1];
42	wakaba	1.1	}
43			return \${\$_[0]}->{$method_name};
44			}
45			};
46			goto &{ $AUTOLOAD };
47			} else {
48			require Carp;
49			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
50			}
51			} # AUTOLOAD
52			sub owner_element ($);
53
54			## The \|Node\| interface - attribute
55
56	wakaba	1.3	sub local_name ($) {
57			## TODO: HTML5
58			return ${+shift}->{local_name};
59			} # local_name
60
61			sub manakai_local_name ($) {
62			return ${+shift}->{local_name};
63			} # manakai_local_name
64
65			sub namespace_uri ($);
66	wakaba	1.2
67			## The name of the attribute [DOM1, DOM2].
68			## Same as \|Attr.name\| [DOM3].
69
70			*node_name = \&name;
71
72			sub node_type () { 2 } # ATTRIBUTE_NODE
73
74			## The value of the attribute [DOM1, DOM2].
75			## Same as \|Attr.value\| [DOM3].
76
77			*node_value = \&value;
78	wakaba	1.1
79	wakaba	1.3	sub prefix ($;$) {
80			## TODO: setter
81			return ${+shift}->{prefix};
82			} # prefix
83
84	wakaba	1.1	## The \|Attr\| interface - attribute
85
86			## TODO: HTML5 case stuff?
87			sub name ($) {
88			my $self = shift;
89			if (defined $$self->{prefix}) {
90			return $$self->{prefix} . ':' . $$self->{local_name};
91			} else {
92			return $$self->{local_name};
93			}
94			} # name
95
96			sub value ($;$) {
97			if (@_ > 1) {
98			${$_[0]}->{value} = $_[1];
99			}
100			return ${$_[0]}->{value};
101			} # value
102
103			package Message::IF::Attr;
104
105			package Message::DOM::Document;
106
107			sub create_attribute ($$) {
108			## TODO: HTML5
109			return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);
110			} # create_attribute
111
112			sub create_attribute_ns ($$$) {
113			my ($prefix, $lname);
114			if (ref $_[2] eq 'ARRAY') {
115			($prefix, $lname) = @{$_[2]};
116			} else {
117			($prefix, $lname) = split /:/, $_[2], 2;
118			($prefix, $lname) = (undef, $prefix) unless defined $lname;
119			}
120			return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);
121			} # create_element_ns
122
123			1;
124			## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
125	wakaba	1.3	## $Date: 2007/06/15 14:32:49 $