1#============================================================= -*-Perl-*-
2#
3# Template::Plugin::Date
4#
5# DESCRIPTION
6#
7#   Plugin to generate formatted date strings.
8#
9# AUTHORS
10#   Thierry-Michel Barral  <kktos@electron-libre.com>
11#   Andy Wardley           <abw@wardley.org>
12#
13# COPYRIGHT
14#   Copyright (C) 2000-2007 Thierry-Michel Barral, Andy Wardley.
15#
16#   This module is free software; you can redistribute it and/or
17#   modify it under the same terms as Perl itself.
18#
19#============================================================================
20
21package Template::Plugin::Date;
22
23use strict;
24use warnings;
25use base 'Template::Plugin';
26
27use POSIX ();
28
29our $VERSION = 2.78;
30our $FORMAT  = '%H:%M:%S %d-%b-%Y';    # default strftime() format
31our @LOCALE_SUFFIX = qw( .ISO8859-1 .ISO_8859-15 .US-ASCII .UTF-8 );
32
33
34#------------------------------------------------------------------------
35# new(\%options)
36#------------------------------------------------------------------------
37
38sub new {
39    my ($class, $context, $params) = @_;
40    bless {
41        $params ? %$params : ()
42    }, $class;
43}
44
45
46#------------------------------------------------------------------------
47# now()
48#
49# Call time() to return the current system time in seconds since the epoch.
50#------------------------------------------------------------------------
51
52sub now {
53    return time();
54}
55
56
57#------------------------------------------------------------------------
58# format()
59# format($time)
60# format($time, $format)
61# format($time, $format, $locale)
62# format($time, $format, $locale, $gmt_flag)
63# format(\%named_params);
64#
65# Returns a formatted time/date string for the specified time, $time,
66# (or the current system time if unspecified) using the $format, $locale,
67# and $gmt values specified as arguments or internal values set defined
68# at construction time).  Specifying a Perl-true value for $gmt will
69# override the local time zone and force the output to be for GMT.
70# Any or all of the arguments may be specified as named parameters which
71# get passed as a hash array reference as the final argument.
72# ------------------------------------------------------------------------
73
74sub format {
75    my $self   = shift;
76    my $params = ref($_[$#_]) eq 'HASH' ? pop(@_) : { };
77    my $time   = shift(@_) || $params->{ time } || $self->{ time }
78                           || $self->now();
79    my $format = @_ ? shift(@_)
80                    : ($params->{ format } || $self->{ format } || $FORMAT);
81    my $locale = @_ ? shift(@_)
82                    : ($params->{ locale } || $self->{ locale });
83    my $gmt = @_ ? shift(@_)
84            : ($params->{ gmt } || $self->{ gmt });
85    my (@date, $datestr);
86
87    if ($time =~ /^-?\d+$/) {
88        # $time is now in seconds since epoch
89        if ($gmt) {
90            @date = (gmtime($time))[0..6];
91        }
92        else {
93            @date = (localtime($time))[0..6];
94        }
95    }
96    else {
97        # if $time is numeric, then we assume it's seconds since the epoch
98        # otherwise, we try to parse it as either a 'Y:M:D H:M:S' or a
99        # 'H:M:S D:M:Y' string
100
101        my @parts = (split(/\D/, $time));
102
103        if (@parts >= 6) {
104            if (length($parts[0]) == 4) {
105                # year is first; assume 'Y:M:D H:M:S'
106                @date = @parts[reverse 0..5];
107            }
108            else {
109                # year is last; assume 'H:M:S D:M:Y'
110                @date = @parts[2,1,0,3..5];
111            }
112        }
113
114        if (!@date) {
115            return (undef, Template::Exception->new('date',
116                   "bad time/date string:  " .
117                   "expects 'h:m:s d:m:y'  got: '$time'"));
118        }
119        $date[4] -= 1;     # correct month number 1-12 to range 0-11
120        $date[5] -= 1900;  # convert absolute year to years since 1900
121        $time = &POSIX::mktime(@date);
122    }
123
124    if ($locale) {
125        # format the date in a specific locale, saving and subsequently
126        # restoring the current locale.
127        my $old_locale = &POSIX::setlocale(&POSIX::LC_ALL);
128
129        # some systems expect locales to have a particular suffix
130        for my $suffix ('', @LOCALE_SUFFIX) {
131            my $try_locale = $locale.$suffix;
132            my $setlocale = &POSIX::setlocale(&POSIX::LC_ALL, $try_locale);
133            if (defined $setlocale && $try_locale eq $setlocale) {
134                $locale = $try_locale;
135                last;
136            }
137        }
138        $datestr = &POSIX::strftime($format, @date);
139        &POSIX::setlocale(&POSIX::LC_ALL, $old_locale);
140    }
141    else {
142        $datestr = &POSIX::strftime($format, @date);
143    }
144
145    return $datestr;
146}
147
148sub calc {
149    my $self = shift;
150    eval { require "Date/Calc.pm" };
151    $self->throw("failed to load Date::Calc: $@") if $@;
152    return Template::Plugin::Date::Calc->new('no context');
153}
154
155sub manip {
156    my $self = shift;
157    eval { require "Date/Manip.pm" };
158    $self->throw("failed to load Date::Manip: $@") if $@;
159    return Template::Plugin::Date::Manip->new('no context');
160}
161
162
163sub throw {
164    my $self = shift;
165    die (Template::Exception->new('date', join(', ', @_)));
166}
167
168
169package Template::Plugin::Date::Calc;
170use base qw( Template::Plugin );
171use vars qw( $AUTOLOAD );
172*throw = \&Template::Plugin::Date::throw;
173
174sub AUTOLOAD {
175    my $self = shift;
176    my $method = $AUTOLOAD;
177
178    $method =~ s/.*:://;
179    return if $method eq 'DESTROY';
180
181    my $sub = \&{"Date::Calc::$method"};
182    $self->throw("no such Date::Calc method: $method")
183        unless $sub;
184
185    &$sub(@_);
186}
187
188package Template::Plugin::Date::Manip;
189use base qw( Template::Plugin );
190use vars qw( $AUTOLOAD );
191*throw = \&Template::Plugin::Date::throw;
192
193sub AUTOLOAD {
194    my $self = shift;
195    my $method = $AUTOLOAD;
196
197    $method =~ s/.*:://;
198    return if $method eq 'DESTROY';
199
200    my $sub = \&{"Date::Manip::$method"};
201    $self->throw("no such Date::Manip method: $method")
202        unless $sub;
203
204    &$sub(@_);
205}
206
207
2081;
209
210__END__
211
212=head1 NAME
213
214Template::Plugin::Date - Plugin to generate formatted date strings
215
216=head1 SYNOPSIS
217
218    [% USE date %]
219
220    # use current time and default format
221    [% date.format %]
222
223    # specify time as seconds since epoch
224    # or as a 'h:m:s d-m-y' or 'y-m-d h:m:s' string
225    [% date.format(960973980) %]
226    [% date.format('4:20:36 21/12/2000') %]
227    [% date.format('2000/12/21 4:20:36') %]
228
229    # specify format
230    [% date.format(mytime, '%H:%M:%S') %]
231
232    # specify locale
233    [% date.format(date.now, '%a %d %b %y', 'en_GB') %]
234
235    # named parameters
236    [% date.format(mytime, format = '%H:%M:%S') %]
237    [% date.format(locale = 'en_GB') %]
238    [% date.format(time   = date.now,
239                   format = '%H:%M:%S',
240                   locale = 'en_GB) %]
241
242    # specify default format to plugin
243    [% USE date(format = '%H:%M:%S', locale = 'de_DE') %]
244
245    [% date.format %]
246    ...
247
248=head1 DESCRIPTION
249
250The C<Date> plugin provides an easy way to generate formatted time and date
251strings by delegating to the C<POSIX> C<strftime()> routine.
252
253The plugin can be loaded via the familiar USE directive.
254
255    [% USE date %]
256
257This creates a plugin object with the default name of 'C<date>'.  An alternate
258name can be specified as such:
259
260    [% USE myname = date %]
261
262The plugin provides the C<format()> method which accepts a time value, a
263format string and a locale name.  All of these parameters are optional
264with the current system time, default format ('C<%H:%M:%S %d-%b-%Y>') and
265current locale being used respectively, if undefined.  Default values
266for the time, format and/or locale may be specified as named parameters
267in the C<USE> directive.
268
269    [% USE date(format = '%a %d-%b-%Y', locale = 'fr_FR') %]
270
271When called without any parameters, the C<format()> method returns a string
272representing the current system time, formatted by C<strftime()> according
273to the default format and for the default locale (which may not be the
274current one, if locale is set in the C<USE> directive).
275
276    [% date.format %]
277
278The plugin allows a time/date to be specified as seconds since the epoch,
279as is returned by C<time()>.
280
281    File last modified: [% date.format(filemod_time) %]
282
283The time/date can also be specified as a string of the form C<h:m:s d/m/y>
284or C<y/m/d h:m:s>.  Any of the characters : / - or space may be used to
285delimit fields.
286
287    [% USE day = date(format => '%A', locale => 'en_GB') %]
288    [% day.format('4:20:00 9-13-2000') %]
289
290Output:
291
292    Tuesday
293
294A format string can also be passed to the C<format()> method, and a locale
295specification may follow that.
296
297    [% date.format(filemod, '%d-%b-%Y') %]
298    [% date.format(filemod, '%d-%b-%Y', 'en_GB') %]
299
300A fourth parameter allows you to force output in GMT, in the case of
301seconds-since-the-epoch input:
302
303    [% date.format(filemod, '%d-%b-%Y', 'en_GB', 1) %]
304
305Note that in this case, if the local time is not GMT, then also specifying
306'C<%Z>' (time zone) in the format parameter will lead to an extremely
307misleading result.
308
309Any or all of these parameters may be named.  Positional parameters
310should always be in the order C<($time, $format, $locale)>.
311
312    [% date.format(format => '%H:%M:%S') %]
313    [% date.format(time => filemod, format => '%H:%M:%S') %]
314    [% date.format(mytime, format => '%H:%M:%S') %]
315    [% date.format(mytime, format => '%H:%M:%S', locale => 'fr_FR') %]
316    [% date.format(mytime, format => '%H:%M:%S', gmt => 1) %]
317    ...etc...
318
319The C<now()> method returns the current system time in seconds since the
320epoch.
321
322    [% date.format(date.now, '%A') %]
323
324The C<calc()> method can be used to create an interface to the C<Date::Calc>
325module (if installed on your system).
326
327    [% calc = date.calc %]
328    [% calc.Monday_of_Week(22, 2001).join('/') %]
329
330The C<manip()> method can be used to create an interface to the C<Date::Manip>
331module (if installed on your system).
332
333    [% manip = date.manip %]
334    [% manip.UnixDate("Noon Yesterday","%Y %b %d %H:%M") %]
335
336=head1 AUTHORS
337
338Thierry-Michel Barral wrote the original plugin.
339
340Andy Wardley provided some minor
341fixups/enhancements, a test script and documentation.
342
343Mark D. Mills cloned C<Date::Manip> from the C<Date::Calc> sub-plugin.
344
345=head1 COPYRIGHT
346
347Copyright (C) 2000-2007 Thierry-Michel Barral, Andy Wardley.
348
349This module is free software; you can redistribute it and/or
350modify it under the same terms as Perl itself.
351
352=head1 SEE ALSO
353
354L<Template::Plugin>, L<POSIX>
355
356