File Coverage

blib/lib/XML/Atom/Util.pm
Criterion Covered Total %
statement 49 59 83.0
branch 13 22 59.0
condition 12 16 75.0
subroutine 10 14 71.4
pod 2 9 22.2
total 86 120 71.6


line stmt bran cond sub pod time code
1             # $Id$
2              
3             package XML::Atom::Util;
4 23     23   102481 use strict;
  23         121  
  23         718  
5              
6 23     23   519 use XML::Atom;
  23         188  
  23         1151  
7 23     23   134 use vars qw( @EXPORT_OK @ISA );
  23         43  
  23         1046  
8 23     23   129 use Encode;
  23         146  
  23         1767  
9 23     23   149 use Exporter;
  23         54  
  23         25674  
10             @EXPORT_OK = qw( set_ns first nodelist childlist textValue iso2dt encode_xml create_element );
11             @ISA = qw( Exporter );
12              
13             our %NS_MAP = (
14             '0.3' => 'http://purl.org/atom/ns#',
15             '1.0' => 'http://www.w3.org/2005/Atom',
16             );
17              
18             our %NS_VERSION = reverse %NS_MAP;
19              
20             sub set_ns {
21 215     215 0 318 my $thing = shift;
22 215         345 my($param) = @_;
23 215 100       511 if (my $ns = delete $param->{Namespace}) {
24 87         225 $thing->{ns} = $ns;
25 87         298 $thing->{version} = $NS_VERSION{$ns};
26             } else {
27 128   66     421 my $version = delete $param->{Version} || $XML::Atom::DefaultVersion;
28 128 100       407 $version = '1.0' if $version == 1;
29 128 50       721 my $ns = $NS_MAP{$version} or $thing->error("Unknown version: $version");
30 128         468 $thing->{ns} = $ns;
31 128         350 $thing->{version} = $version;
32             }
33             }
34              
35             sub ns_to_version {
36 81     81 0 167 my $ns = shift;
37 81         465 $NS_VERSION{$ns};
38             }
39              
40             sub first {
41 0     0 0 0 my @nodes = nodelist(@_);
42 0 0       0 return unless @nodes;
43 0         0 return $nodes[0];
44             }
45              
46             sub nodelist {
47 0     0 0 0 if (LIBXML) {
48 0 0       0 return $_[1] ? $_[0]->getElementsByTagNameNS($_[1], $_[2]) :
49             $_[0]->getElementsByTagName($_[2]);
50             } else {
51             my $set = $_[1] ?
52             $_[0]->find("descendant::*[local-name()='$_[2]' and namespace-uri()='$_[1]']") :
53             $_[0]->find("descendant::$_[2]");
54             return unless $set && $set->isa('XML::XPath::NodeSet');
55             return $set->get_nodelist;
56             }
57             }
58              
59             sub childlist {
60 180     180 0 252 if (LIBXML) {
61 180 50       663 return $_[1] ? $_[0]->getChildrenByTagNameNS($_[1], $_[2]) :
62             $_[0]->getChildrenByTagName($_[2]);
63             } else {
64             my $set = $_[1] ?
65             $_[0]->find("*[local-name()='$_[2]' and namespace-uri()='$_[1]']") :
66             $_[0]->find($_[2]);
67             return unless $set && $set->isa('XML::XPath::NodeSet');
68             return $set->get_nodelist;
69             }
70             }
71              
72             sub textValue {
73 0 0   0 0 0 my $node = first(@_) or return;
74 0         0 LIBXML ? $node->textContent : $node->string_value;
75             }
76              
77             sub iso2dt {
78 12     12 1 7838 my($iso) = @_;
79 12 50       120 return unless $iso =~ /^(\d{4})(?:-?(\d{2})(?:-?(\d\d?)(?:T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(?:Z|([+-]\d{2}:\d{2}))?)?)?)?/;
80 12   50     129 my($y, $mo, $d, $h, $m, $s, $zone) =
      50        
      100        
      100        
      100        
81             ($1, $2 || 1, $3 || 1, $4 || 0, $5 || 0, $6 || 0, $7);
82 12         65 require DateTime;
83 12         54 my $dt = DateTime->new(
84             year => $y,
85             month => $mo,
86             day => $d,
87             hour => $h,
88             minute => $m,
89             second => $s,
90             time_zone => 'UTC',
91             );
92 12 100 66     4601 if ($zone && $zone ne 'Z') {
93 8         24 my $seconds = DateTime::TimeZone::offset_as_seconds($zone);
94 8         694 $dt->subtract(seconds => $seconds);
95             }
96 12         6969 $dt;
97             }
98              
99             my %Map = ('&' => '&amp;', '"' => '&quot;', '<' => '&lt;', '>' => '&gt;',
100             '\'' => '&apos;');
101             my $RE = join '|', keys %Map;
102              
103             sub encode_xml {
104 0     0 1 0 my($str) = @_;
105 0         0 $str =~ s!($RE)!$Map{$1}!g;
106 0         0 $str;
107             }
108              
109             sub create_element {
110 47     47 0 108 my($ns, $name) = @_;
111 47         73 my($ns_uri, $ns_prefix);
112 47 100       123 if (ref $ns eq 'XML::Atom::Namespace') {
113 7         15 $ns_uri = $ns->{uri};
114 7         11 $ns_prefix = $ns->{prefix};
115             } else {
116 40         74 $ns_uri = $ns;
117             }
118 47         64 my $elem;
119 47         69 if (LIBXML) {
120 47         228 $elem = XML::LibXML::Element->new($name);
121 47 100       207 $elem->setNamespace($ns_uri, $ns_prefix ? $ns_prefix : ());
122             } else {
123             $ns_prefix ||= '#default';
124             $elem = XML::XPath::Node::Element->new($name);
125             my $ns = XML::XPath::Node::Namespace->new($ns_prefix => $ns_uri);
126             $elem->appendNamespace($ns);
127             }
128 47         1098 return $elem;
129             }
130              
131             1;
132             __END__
133              
134             =head1 NAME
135              
136             XML::Atom::Util - Utility functions
137              
138             =head1 SYNOPSIS
139              
140             use XML::Atom::Util qw( iso2dt );
141             my $dt = iso2dt($entry->issued);
142              
143             =head1 USAGE
144              
145             =head2 iso2dt($iso)
146              
147             Transforms the ISO-8601 date I<$iso> into a I<DateTime> object and returns
148             the I<DateTime> object.
149              
150             =head2 encode_xml($str)
151              
152             Encodes characters with special meaning in XML into entities and returns
153             the encoded string.
154              
155             =head1 AUTHOR & COPYRIGHT
156              
157             Please see the I<XML::Atom> manpage for author, copyright, and license
158             information.
159              
160             =cut