root/trunk/plagger/lib/Plagger/Date.pm

Revision 1833 (checked in by miyagawa, 14 years ago)

Support DateTime?::Format::Japanese in parse_dwim, hence in EFT scripts.
Fixes #442

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger::Date;
2 use strict;
3 use base qw( DateTime );
4
5 use Encode;
6 use DateTime::Format::Strptime;
7 use DateTime::TimeZone;
8 use UNIVERSAL::require;
9
10 sub rebless { bless $_[1], $_[0] }
11
12 sub parse {
13     my($class, $format, $date) = @_;
14
15     my $module;
16     if (ref $format) {
17         $module = $format;
18     } else {
19         $module = "DateTime::Format::$format";
20         $module->require or die $@;
21     }
22
23     my $dt = $module->parse_datetime($date) or return;
24     bless $dt, $class;
25 }
26
27 sub parse_dwim {
28     my($class, $str) = @_;
29
30     # check if it's Japanese
31     if ($str =~ /^(\x{5E73}\x{6210}|\x{662D}\x{548C}|\x{5927}\x{6B63}|\x{660E}\x{6CBB})/) {
32         eval { require DateTime::Format::Japanese };
33         if ($@) {
34             Plagger->context->log(warn => "requires DateTime::Format::Japanese to parse '$str'");
35             return;
36         }
37         return $class->parse( 'Japanese', encode_utf8($str) );
38     }
39
40     require Date::Parse;
41     my %p;
42     @p{qw( second minute hour day month year zone )} = Date::Parse::strptime($str);
43
44     unless (defined($p{year}) && defined($p{month}) && defined($p{day})) {
45         return;
46     }
47
48     $p{year} += 1900;
49     $p{month}++;
50
51     my $zone = delete $p{zone};
52     for (qw( second minute hour )) {
53         delete $p{$_} unless defined $p{$_};
54     }
55
56     my $dt = $class->new(%p);
57
58     if (defined $zone) {
59         my $tz = DateTime::TimeZone::offset_as_string($zone);
60         $dt->set_time_zone($tz);
61     }
62
63     $dt;
64 }
65
66 sub strptime {
67     my($class, $pattern, $date) = @_;
68     Encode::_utf8_on($pattern);
69     my $format = DateTime::Format::Strptime->new(pattern => $pattern);
70     $class->parse($format, $date);
71 }
72
73 sub now {
74     my($class, %opt) = @_;
75     my $self = $class->SUPER::now();
76
77     my $tz = $opt{timezone} || Plagger->context->conf->{timezone} || 'local';
78     $self->set_time_zone($tz);
79
80     $self;
81 }
82
83 sub from_epoch {
84     my $class = shift;
85     my %p = @_ == 1 ? (epoch => $_[0]) : @_;
86     $class->SUPER::from_epoch(%p);
87 }
88
89 sub format {
90     my($self, $format) = @_;
91
92     my $module;
93     if (ref $format) {
94         $module = $format;
95     } else {
96         $module = "DateTime::Format::$format";
97         $module->require or die $@;
98     }
99
100     $module->format_datetime($self);
101 }
102
103 sub set_time_zone {
104     my $self = shift;
105
106     eval {
107         $self->SUPER::set_time_zone(@_);
108     };
109     if ($@) {
110         $self->SUPER::set_time_zone('UTC');
111     }
112
113     return $self;
114 }
115
116 sub serialize {
117     my $self = shift;
118     $self->format('W3CDTF');
119 }
120
121 1;
122
123 __END__
124
125 =head1 NAME
126
127 Plagger::Date - DateTime subclass for Plagger
128
129 =head1 SYNOPSIS
130
131
132
133 =head1 DESCRIPTION
134
135 This module subclasses DateTime for plagger's own needs.
136
137 =over
138
139 =item rebless
140
141 ...
142
143 =item parse
144
145 ...
146
147 =item parse_dwim
148
149 ...
150
151 =item strptime
152
153 ...
154
155 =item now
156
157 ...
158
159 =item from_epoch
160
161 ...
162
163 =item format($format)
164
165 Convenience method.  Returns the datetime in the format
166 passed (either a formatter object or a blessed reference)
167
168 =item set_time_zone
169
170 Overrides default behavior to default to UTC if the passed
171 time zone isn't a legal
172
173 =item serialize
174
175 Returns the object as a W3CDTF string.
176
177 =cut
178
179 =back
180
181 =head1 AUTHOR
182
183 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
184
185 See I<AUTHORS> file for the name of all the contributors.
186
187 =head1 LICENSE
188
189 Except where otherwise noted, Plagger is free software; you can
190 redistribute it and/or modify it under the same terms as Perl itself.
191
192 =head1 SEE ALSO
193
194 L<http://plagger.org/>, L<DateTime>
195
196 =cut
Note: See TracBrowser for help on using the browser.