local-lib5/lib/perl5/DateTime/Format/W3CDTF.pm

   1 package DateTime::Format::W3CDTF;
   2
   3 use strict;
   4
   5 use vars qw ($VERSION);
   6
   7 $VERSION = '0.05';
   8
   9 use DateTime;
  10
  11 sub new {
  12     my $class = shift;
  13
  14     return bless {}, $class;
  15 }
  16
  17 # key is string length
  18 my %valid_formats = (
  19     19 => {
  20         params => [qw( year month day hour minute second)],
  21         regex  => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/,
  22         zero   => {},
  23     },
  24     16 => {
  25         params => [qw( year month day hour minute)],
  26         regex  => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d)$/,
  27         zero   => { second => 0 },
  28     },
  29     10 => {
  30         params => [qw( year month day )],
  31         regex  => qr/^(\d{4})-(\d\d)-(\d\d)$/,
  32         zero   => { hour => 0, minute => 0, second => 0 },
  33     },
  34     7 => {
  35         params => [qw( year month )],
  36         regex  => qr/^(\d{4})-(\d\d)$/,
  37         zero   => { day => 1, hour => 0, minute => 0, second => 0 },
  38     },
  39     4 => {
  40         params => [qw( year )],
  41         regex  => qr/^(\d\d\d\d)$/,
  42         zero => { month => 1, day => 1, hour => 0, minute => 0, second => 0 }
  43     }
  44 );
  45
  46 sub parse_datetime {
  47     my ( $self, $date ) = @_;
  48
  49     # save for error messages
  50     my $original = $date;
  51
  52     my %p;
  53     if ( $date =~ s/([+-]\d\d:\d\d)$// ) {
  54         $p{time_zone} = $1;
  55     }
  56
  57     # Z at end means UTC
  58     elsif ( $date =~ s/Z$// ) {
  59         $p{time_zone} = 'UTC';
  60     }
  61     else {
  62         $p{time_zone} = 'floating';
  63     }
  64
  65     my $format = $valid_formats{ length $date }
  66         or die "Invalid W3CDTF datetime string ($original)";
  67
  68     @p{ @{ $format->{params} } } = $date =~ /$format->{regex}/;
  69
  70     return DateTime->new( %p, %{ $format->{zero} } );
  71 }
  72
  73 sub format_datetime {
  74     my ( $self, $dt ) = @_;
  75
  76     # removed in 0.4 as it behaved improperly at midnight - kellan 2003/11/23
  77     #my $base =
  78     #    ( $dt->hour || $dt->min || $dt->sec ?
  79     #      sprintf( '%04d-%02d-%02dT%02d:%02d:%02d',
  80     #               $dt->year, $dt->month, $dt->day,
  81     #               $dt->hour, $dt->minute, $dt->second ) :
  82     #      sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day )
  83     #    );
  84
  85     my $base = sprintf(
  86         '%04d-%02d-%02dT%02d:%02d:%02d',
  87         $dt->year, $dt->month,  $dt->day,
  88         $dt->hour, $dt->minute, $dt->second
  89     );
  90
  91     my $tz = $dt->time_zone;
  92
  93     return $base if $tz->is_floating;
  94
  95     return $base . 'Z' if $tz->is_utc;
  96
  97     my $offset = $dt->offset();
  98
  99     return $base unless defined $offset;
 100
 101     return $base . offset_as_string($offset)
 102 }
 103
 104 sub format_date {
 105     my ( $self, $dt ) = @_;
 106
 107     my $base = sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day );
 108     return $base;
 109 }
 110
 111 # minor offset_as_string variant w/ :
 112 #
 113 sub offset_as_string {
 114     my $offset = shift;
 115
 116     return undef unless defined $offset;
 117
 118     my $sign = $offset < 0 ? '-' : '+';
 119
 120     my $hours = $offset / ( 60 * 60 );
 121     $hours = abs($hours) % 24;
 122
 123     my $mins = ( $offset % ( 60 * 60 ) ) / 60;
 124
 125     my $secs = $offset % 60;
 126
 127     return (
 128         $secs
 129         ? sprintf( '%s%02d:%02d:%02d', $sign, $hours, $mins, $secs )
 130         : sprintf( '%s%02d:%02d',      $sign, $hours, $mins )
 131     );
 132 }
 133
 134 1;
 135
 136 __END__
 137
 138 =head1 NAME
 139
 140 DateTime::Format::W3CDTF - Parse and format W3CDTF datetime strings
 141
 142 =head1 SYNOPSIS
 143
 144   use DateTime::Format::W3CDTF;
 145
 146   my $w3c = DateTime::Format::W3CDTF->new;
 147   my $dt = $w3c->parse_datetime( '2003-02-15T13:50:05-05:00' );
 148
 149   # 2003-02-15T13:50:05-05:00
 150   $w3c->format_datetime($dt);
 151
 152 =head1 DESCRIPTION
 153
 154 This module understands the W3CDTF date/time format, an ISO 8601 profile,
 155 defined at http://www.w3.org/TR/NOTE-datetime.  This format as the native
 156 date format of RSS 1.0.
 157
 158 It can be used to parse these formats in order to create the appropriate
 159 objects.
 160
 161 =head1 METHODS
 162
 163 This API is currently experimental and may change in the future.
 164
 165 =over 4
 166
 167 =item * parse_datetime($string)
 168
 169 Given a W3CDTF datetime string, this method will return a new
 170 C<DateTime> object.
 171
 172 If given an improperly formatted string, this method may die.
 173
 174 =item * format_datetime($datetime)
 175
 176 Given a C<DateTime> object, this methods returns a W3CDTF datetime
 177 string.
 178
 179 NOTE: As of version 0.4, format_datetime no longer attempts to truncate
 180 datetimes without a time component.  This is due to the fact that C<DateTime>
 181 doesn't distinguish between a date with no time component, and midnight.
 182
 183 =item * format_date($datetime)
 184
 185 Given a C<DateTime> object, return a W3CDTF datetime string without the time component.
 186
 187 =back
 188
 189 =head1 SUPPORT
 190
 191 Support for this module is provided via the datetime@perl.org email
 192 list. See http://datetime.perl.org/?MailingList for details.
 193
 194 Please submit bugs to the CPAN RT system at
 195 http://rt.cpan.org/NoAuth/ReportBug.html?Queue=datetime-format-w3cdtf or via
 196 email at bug-datetime-format-w3cdtf@rt.cpan.org.
 197
 198 =head1 AUTHOR
 199
 200 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 201
 202 =head1 CREDITS
 203
 204 This module was originally created by Kellan Elliott-McCrea
 205 E<lt>kellan@protest.netE<gt>.
 206
 207 This module was inspired by L<DateTime::Format::ICal>
 208
 209 =head1 COPYRIGHT
 210
 211 Copyright (c) 2009 David Rolsky.  All rights reserved.  This
 212 program is free software; you can redistribute it and/or modify it
 213 under the same terms as Perl itself.
 214
 215 Copyright (c) 2003 Kellan Elliott-McCrea
 216
 217 Portions of the code in this distribution are derived from other
 218 works.  Please see the CREDITS file for more details.
 219
 220 The full text of the license can be found in the LICENSE file included
 221 with this module.
 222
 223 =head1 SEE ALSO
 224
 225 datetime@perl.org mailing list
 226
 227 http://datetime.perl.org/
 228
 229 =cut