File Coverage

blib/lib/XML/LibXML/AttributeHash.pm
Criterion Covered Total %
statement 71 79 89.8
branch 25 32 78.1
condition n/a
subroutine 17 19 89.4
pod 0 4 0.0
total 113 134 84.3


line stmt bran cond sub pod time code
1             package XML::LibXML::AttributeHash;
2              
3 66     66   513 use strict;
  66         140  
  66         2332  
4 66     66   363 use warnings;
  66         126  
  66         2027  
5 66     66   380 use Scalar::Util qw//;
  66         143  
  66         1147  
6 66     66   2193 use Tie::Hash;
  66         3152  
  66         3761  
7             our @ISA = qw/Tie::Hash/;
8              
9 66     66   496 use vars qw($VERSION);
  66         181  
  66         8240  
10             $VERSION = "2.0207"; # VERSION TEMPLATE: DO NOT CHANGE
11              
12             BEGIN
13             {
14             *__HAS_WEAKEN = defined(&Scalar::Util::weaken)
15             ? sub () { 1 }
16 66 50   66   65943 : sub () { 0 };
17             };
18              
19             sub element
20             {
21 24     24 0 185 return $_[0][0];
22             }
23              
24             sub from_clark
25             {
26 20     20 0 39 my ($self, $str) = @_;
27 20 100       116 if ($str =~ m! \{ (.+) \} (.+) !x)
28             {
29 10         45 return ($1, $2);
30             }
31 10         30 return (undef, $str);
32             }
33              
34             sub to_clark
35             {
36 7     7 0 20 my ($self, $ns, $local) = @_;
37 7 100       48 defined $ns ? "{$ns}$local" : $local;
38             }
39              
40             sub all_keys
41             {
42 4     4 0 11 my ($self, @keys) = @_;
43              
44 4         13 my $elem = $self->element;
45              
46 4 50       32 foreach my $attr (defined($elem) ? $elem->attributes : ())
47             {
48 11 100       66 if (! $attr->isa('XML::LibXML::Namespace'))
49             {
50 7         65 push @keys, $self->to_clark($attr->namespaceURI, $attr->localname);
51             }
52             }
53              
54 4         84 return sort @keys;
55             }
56              
57             sub TIEHASH
58             {
59 5     5   24 my ($class, $element, %args) = @_;
60 5         16 my $self = bless [$element, undef, \%args], $class;
61 5 50       19 if (__HAS_WEAKEN and $args{weaken})
62             {
63 5         37 Scalar::Util::weaken( $self->[0] );
64             }
65 5         17 return $self;
66             }
67              
68             sub STORE
69             {
70 5     5   16 my ($self, $key, $value) = @_;
71 5         13 my ($key_ns, $key_local) = $self->from_clark($key);
72 5 100       15 if (defined $key_ns)
73             {
74 3         10 return $self->element->setAttributeNS($key_ns, "xxx:$key_local", "$value");
75             }
76             else
77             {
78 2         5 return $self->element->setAttribute($key_local, "$value");
79             }
80             }
81              
82             sub FETCH
83             {
84 11     11   1673 my ($self, $key) = @_;
85 11         30 my ($key_ns, $key_local) = $self->from_clark($key);
86 11 100       34 if (defined $key_ns)
87             {
88 5         24 return $self->element->getAttributeNS($key_ns, "$key_local");
89             }
90             else
91             {
92 6         15 return $self->element->getAttribute($key_local);
93             }
94             }
95              
96             sub EXISTS
97             {
98 2     2   7 my ($self, $key) = @_;
99 2         8 my ($key_ns, $key_local) = $self->from_clark($key);
100 2 100       8 if (defined $key_ns)
101             {
102 1         3 return $self->element->hasAttributeNS($key_ns, "$key_local");
103             }
104             else
105             {
106 1         5 return $self->element->hasAttribute($key_local);
107             }
108             }
109              
110             sub DELETE
111             {
112 2     2   9 my ($self, $key) = @_;
113 2         8 my ($key_ns, $key_local) = $self->from_clark($key);
114 2 100       11 if (defined $key_ns)
115             {
116 1         5 return $self->element->removeAttributeNS($key_ns, "$key_local");
117             }
118             else
119             {
120 1         4 return $self->element->removeAttribute($key_local);
121             }
122             }
123              
124             sub FIRSTKEY
125             {
126 4     4   12 my ($self) = @_;
127 4         17 my @keys = $self->all_keys;
128 4         14 $self->[1] = \@keys;
129 4 50       15 if (wantarray)
130             {
131 0         0 return ($keys[0], $self->FETCH($keys[0]));
132             }
133 4         29 $keys[0];
134             }
135              
136             sub NEXTKEY
137             {
138 7     7   17 my ($self, $lastkey) = @_;
139 7 50       20 my @keys = defined $self->[1] ? @{ $self->[1] } : $self->all_keys;
  7         18  
140 7         13 my $found;
141 7         19 foreach my $k (@keys)
142             {
143 16 100       38 if ($k gt $lastkey)
144             {
145 4 50       14 $found = $k and last;
146             }
147             }
148 7 100       19 if (!defined $found)
149             {
150 3         9 $self->[1] = undef;
151 3         13 return;
152             }
153 4 50       12 if (wantarray)
154             {
155 0         0 return ($found, $self->FETCH($found));
156             }
157 4         20 return $found;
158             }
159              
160             sub SCALAR
161             {
162 0     0     my ($self) = @_;
163 0           return $self->element;
164             }
165              
166             sub CLEAR
167             {
168 0     0     my ($self) = @_;
169 0           foreach my $k ($self->all_keys)
170             {
171 0           $self->DELETE($k);
172             }
173 0           return $self;
174             }
175              
176             __PACKAGE__
177             __END__