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