local-lib5/lib/perl5/XML/Atom/Util.pm

   1 # $Id$
   2
   3 package XML::Atom::Util;
   4 use strict;
   5
   6 use XML::Atom;
   7 use vars qw( @EXPORT_OK @ISA );
   8 use Encode;
   9 use Exporter;
  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     my $thing = shift;
  22     my($param) = @_;
  23     if (my $ns = delete $param->{Namespace}) {
  24         $thing->{ns}      = $ns;
  25         $thing->{version} = $NS_VERSION{$ns};
  26     } else  {
  27         my $version = delete $param->{Version} || $XML::Atom::DefaultVersion;
  28         $version    = '1.0' if $version == 1;
  29         my $ns = $NS_MAP{$version} or $thing->error("Unknown version: $version");
  30         $thing->{ns} = $ns;
  31         $thing->{version} = $version;
  32     }
  33 }
  34
  35 sub ns_to_version {
  36     my $ns = shift;
  37     $NS_VERSION{$ns};
  38 }
  39
  40 sub first {
  41     my @nodes = nodelist(@_);
  42     return unless @nodes;
  43     return $nodes[0];
  44 }
  45
  46 sub nodelist {
  47     if (LIBXML) {
  48         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     if (LIBXML) {
  61         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     my $node = first(@_) or return;
  74     LIBXML ? $node->textContent : $node->string_value;
  75 }
  76
  77 sub iso2dt {
  78     my($iso) = @_;
  79     return unless $iso =~ /^(\d{4})(?:-?(\d{2})(?:-?(\d\d?)(?:T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(?:Z|([+-]\d{2}:\d{2}))?)?)?)?/;
  80     my($y, $mo, $d, $h, $m, $s, $zone) =
  81         ($1, $2 || 1, $3 || 1, $4 || 0, $5 || 0, $6 || 0, $7);
  82     require DateTime;
  83     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     if ($zone && $zone ne 'Z') {
  93         my $seconds = DateTime::TimeZone::offset_as_seconds($zone);
  94         $dt->subtract(seconds => $seconds);
  95     }
  96     $dt;
  97 }
  98
  99 my %Map = ('&' => '&amp;', '"' => '&quot;', '<' => '&lt;', '>' => '&gt;',
 100            '\'' => '&apos;');
 101 my $RE = join '|', keys %Map;
 102
 103 sub encode_xml {
 104     my($str) = @_;
 105     $str =~ s!($RE)!$Map{$1}!g;
 106     $str;
 107 }
 108
 109 sub create_element {
 110     my($ns, $name) = @_;
 111     my($ns_uri, $ns_prefix);
 112     if (ref $ns eq 'XML::Atom::Namespace') {
 113         $ns_uri = $ns->{uri};
 114         $ns_prefix = $ns->{prefix};
 115     } else {
 116         $ns_uri = $ns;
 117     }
 118     my $elem;
 119     if (LIBXML) {
 120         $elem = XML::LibXML::Element->new($name);
 121         $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     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