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 67     67   508 use strict;
  67         134  
  67         2199  
4 67     67   408 use warnings;
  67         146  
  67         1906  
5 67     67   368 use Scalar::Util qw//;
  67         149  
  67         1127  
6 67     67   1922 use Tie::Hash;
  67         2992  
  67         3585  
7             our @ISA = qw/Tie::Hash/;
8              
9 67     67   454 use vars qw($VERSION);
  67         197  
  67         7283  
10             $VERSION = "2.0209"; # VERSION TEMPLATE: DO NOT CHANGE
11              
12             BEGIN
13             {
14             *__HAS_WEAKEN = defined(&Scalar::Util::weaken)
15             ? sub () { 1 }
16 67 50   67   66553 : sub () { 0 };
17             };
18              
19             sub element
20             {
21 24     24 0 162 return $_[0][0];
22             }
23              
24             sub from_clark
25             {
26 20     20 0 43 my ($self, $str) = @_;
27 20 100       120 if ($str =~ m! \{ (.+) \} (.+) !x)
28             {
29 10         49 return ($1, $2);
30             }
31 10         38 return (undef, $str);
32             }
33              
34             sub to_clark
35             {
36 7     7 0 20 my ($self, $ns, $local) = @_;
37 7 100       38 defined $ns ? "{$ns}$local" : $local;
38             }
39              
40             sub all_keys
41             {
42 4     4 0 9 my ($self, @keys) = @_;
43              
44 4         11 my $elem = $self->element;
45              
46 4 50       25 foreach my $attr (defined($elem) ? $elem->attributes : ())
47             {
48 11 100       59 if (! $attr->isa('XML::LibXML::Namespace'))
49             {
50 7         49 push @keys, $self->to_clark($attr->namespaceURI, $attr->localname);
51             }
52             }
53              
54 4         74 return sort @keys;
55             }
56              
57             sub TIEHASH
58             {
59 5     5   23 my ($class, $element, %args) = @_;
60 5         18 my $self = bless [$element, undef, \%args], $class;
61 5 50       18 if (__HAS_WEAKEN and $args{weaken})
62             {
63 5         32 Scalar::Util::weaken( $self->[0] );
64             }
65 5         16 return $self;
66             }
67              
68             sub STORE
69             {
70 5     5   12 my ($self, $key, $value) = @_;
71 5         14 my ($key_ns, $key_local) = $self->from_clark($key);
72 5 100       20 if (defined $key_ns)
73             {
74 3         10 return $self->element->setAttributeNS($key_ns, "xxx:$key_local", "$value");
75             }
76             else
77             {
78 2         8 return $self->element->setAttribute($key_local, "$value");
79             }
80             }
81              
82             sub FETCH
83             {
84 11     11   2391 my ($self, $key) = @_;
85 11         31 my ($key_ns, $key_local) = $self->from_clark($key);
86 11 100       30 if (defined $key_ns)
87             {
88 5         16 return $self->element->getAttributeNS($key_ns, "$key_local");
89             }
90             else
91             {
92 6         17 return $self->element->getAttribute($key_local);
93             }
94             }
95              
96             sub EXISTS
97             {
98 2     2   9 my ($self, $key) = @_;
99 2         8 my ($key_ns, $key_local) = $self->from_clark($key);
100 2 100       10 if (defined $key_ns)
101             {
102 1         8 return $self->element->hasAttributeNS($key_ns, "$key_local");
103             }
104             else
105             {
106 1         4 return $self->element->hasAttribute($key_local);
107             }
108             }
109              
110             sub DELETE
111             {
112 2     2   15 my ($self, $key) = @_;
113 2         8 my ($key_ns, $key_local) = $self->from_clark($key);
114 2 100       8 if (defined $key_ns)
115             {
116 1         16 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   16 my ($self) = @_;
127 4         13 my @keys = $self->all_keys;
128 4         16 $self->[1] = \@keys;
129 4 50       22 if (wantarray)
130             {
131 0         0 return ($keys[0], $self->FETCH($keys[0]));
132             }
133 4         25 $keys[0];
134             }
135              
136             sub NEXTKEY
137             {
138 7     7   20 my ($self, $lastkey) = @_;
139 7 50       17 my @keys = defined $self->[1] ? @{ $self->[1] } : $self->all_keys;
  7         24  
140 7         12 my $found;
141 7         17 foreach my $k (@keys)
142             {
143 16 100       36 if ($k gt $lastkey)
144             {
145 4 50       15 $found = $k and last;
146             }
147             }
148 7 100       24 if (!defined $found)
149             {
150 3         13 $self->[1] = undef;
151 3         54 return;
152             }
153 4 50       10 if (wantarray)
154             {
155 0         0 return ($found, $self->FETCH($found));
156             }
157 4         22 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__