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