1# we need to comment this out or PAUSE might index it
2# pack age DateTime::Format::W3CDTF;
3
4use strict;
5
6use DateTime::Format::Builder (
7    parsers => {
8        parse_datetime => [
9            [ preprocess => \&_parse_tz ],
10            {
11                params => [qw( year month day hour minute second)],
12                regex =>
13                    qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)\.(\d\d)$/,
14                length => 22,
15            },
16            {
17                params => [qw( year month day hour minute second)],
18                regex  => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/,
19                length => 19,
20            },
21            {
22                params => [qw( year month day hour minute)],
23                regex  => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d)$/,
24                length => 16,
25            },
26            {
27                params => [qw( year month day )],
28                regex  => qr/^(\d{4})-(\d\d)-(\d\d)$/,
29                length => 10,
30            },
31            {
32                params => [qw( year month )],
33                regex  => qr/^(\d{4})-(\d\d)$/,
34                length => 7,
35                extra  => { day => 1 },
36            },
37            {
38                params => [qw( year )],
39                regex  => qr/^(\d\d\d\d)$/,
40                length => 4,
41                extra  => { month => 1, day => 1 }
42            }
43        ]
44    }
45);
46
47sub _parse_tz {
48    my %args = @_;
49    my ( $date, $p ) = @args{qw( input parsed )};
50    if ( $date =~ s/([+-]\d\d:\d\d)$// ) {
51        $p->{time_zone} = $1;
52    }
53
54    # Z at end means UTC
55    elsif ( $date =~ s/Z$// ) {
56        $p->{time_zone} = 'UTC';
57    }
58    else {
59        $p->{time_zone} = 'floating';
60    }
61    return $date;
62}
63
64sub format_datetime {
65    my ( $self, $dt ) = @_;
66
67    my $base = (
68        $dt->hour || $dt->min || $dt->sec
69        ? sprintf(
70            '%04d-%02d-%02dT%02d:%02d:%02d',
71            $dt->year, $dt->month,  $dt->day,
72            $dt->hour, $dt->minute, $dt->second
73            )
74        : sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day )
75    );
76
77    my $tz = $dt->time_zone;
78
79    return $base if $tz->is_floating;
80
81    # if there is a time component
82    if ( $dt->hour || $dt->min || $dt->sec ) {
83        return $base . 'Z' if $tz->is_utc;
84
85        if ( $tz->{'offset'} ) {
86            return $base . offset_as_string( $tz->{'offset'} );
87        }
88    }
89    else {
90        return $base;
91    }
92}
93
94# minor offset_as_string variant w/ :
95#
96sub offset_as_string {
97    my $offset = shift;
98
99    return undef unless defined $offset;
100
101    my $sign = $offset < 0 ? '-' : '+';
102
103    my $hours = $offset / ( 60 * 60 );
104    $hours = abs($hours) % 24;
105
106    my $mins = ( $offset % ( 60 * 60 ) ) / 60;
107
108    my $secs = $offset % 60;
109
110    return (
111        $secs
112        ? sprintf( '%s%02d:%02d:%02d', $sign, $hours, $mins, $secs )
113        : sprintf( '%s%02d:%02d',      $sign, $hours, $mins )
114    );
115}
116
1171;
118
119__END__
120
121=head1 NAME
122
123DateTime::Format::W3CDTF - Parse and format W3CDTF datetime strings
124
125=head1 SYNOPSIS
126
127  use DateTime::Format::W3CDTF;
128
129  my $f = DateTime::Format::W3CDTF->new;
130  my $dt = $f->parse_datetime( '2003-02-15T13:50:05-05:00' );
131
132  # 2003-02-15T13:50:05-05:00
133  $f->format_datetime($dt);
134
135=head1 DESCRIPTION
136
137This module understands the W3CDTF date/time format, an ISO 8601 profile,
138defined at http://www.w3.org/TR/NOTE-datetime.  This format as the native
139date format of RSS 1.0.
140
141It can be used to parse these formats in order to create the appropriate
142objects.
143
144=head1 METHODS
145
146This API is currently experimental and may change in the future.
147
148=over 4
149
150=item * parse_datetime($string)
151
152Given a W3CDTF datetime string, this method will return a new
153C<DateTime> object.
154
155If given an improperly formatted string, this method may die.
156
157=item * format_datetime($datetime)
158
159Given a C<DateTime> object, this methods returns a W3CDTF datetime
160string.
161
162=back
163
164=head1 SUPPORT
165
166Support for this module is provided via the datetime@perl.org email
167list.  See http://lists.perl.org/ for more details.
168
169=head1 AUTHOR
170
171Kellan Elliott-McCrea <kellan@protest.net>
172
173This module was inspired by C<DateTime::Format::ICal>
174
175=head1 COPYRIGHT
176
177Copyright (c) 2003 Kellan Elliott-McCrea.  All rights reserved.  This program
178is free software; you can redistribute it and/or modify it under the
179same terms as Perl itself.
180
181The full text of the license can be found in the LICENSE file included
182with this module.
183
184=head1 SEE ALSO
185
186datetime@perl.org mailing list
187
188http://datetime.perl.org/
189
190=cut
191