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