local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Template/Plugin/Date.pm

   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
  21 package Template::Plugin::Date;
  22
  23 use strict;
  24 use warnings;
  25 use base 'Template::Plugin';
  26
  27 use POSIX ();
  28
  29 our $VERSION = 2.78;
  30 our $FORMAT  = '%H:%M:%S %d-%b-%Y';    # default strftime() format
  31 our @LOCALE_SUFFIX = qw( .ISO8859-1 .ISO_8859-15 .US-ASCII .UTF-8 );
  32
  33
  34 #------------------------------------------------------------------------
  35 # new(\%options)
  36 #------------------------------------------------------------------------
  37
  38 sub 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
  52 sub 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
  74 sub 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(/(?:\/| |:|-)/, $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
 148 sub 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
 155 sub 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
 163 sub throw {
 164     my $self = shift;
 165     die (Template::Exception->new('date', join(', ', @_)));
 166 }
 167
 168
 169 package Template::Plugin::Date::Calc;
 170 use base qw( Template::Plugin );
 171 use vars qw( $AUTOLOAD );
 172 *throw = \&Template::Plugin::Date::throw;
 173
 174 sub 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
 188 package Template::Plugin::Date::Manip;
 189 use base qw( Template::Plugin );
 190 use vars qw( $AUTOLOAD );
 191 *throw = \&Template::Plugin::Date::throw;
 192
 193 sub 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
 208 1;
 209
 210 __END__
 211
 212 =head1 NAME
 213
 214 Template::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
 250 The C<Date> plugin provides an easy way to generate formatted time and date
 251 strings by delegating to the C<POSIX> C<strftime()> routine.
 252
 253 The plugin can be loaded via the familiar USE directive.
 254
 255     [% USE date %]
 256
 257 This creates a plugin object with the default name of 'C<date>'.  An alternate
 258 name can be specified as such:
 259
 260     [% USE myname = date %]
 261
 262 The plugin provides the C<format()> method which accepts a time value, a
 263 format string and a locale name.  All of these parameters are optional
 264 with the current system time, default format ('C<%H:%M:%S %d-%b-%Y>') and
 265 current locale being used respectively, if undefined.  Default values
 266 for the time, format and/or locale may be specified as named parameters
 267 in the C<USE> directive.
 268
 269     [% USE date(format = '%a %d-%b-%Y', locale = 'fr_FR') %]
 270
 271 When called without any parameters, the C<format()> method returns a string
 272 representing the current system time, formatted by C<strftime()> according
 273 to the default format and for the default locale (which may not be the
 274 current one, if locale is set in the C<USE> directive).
 275
 276     [% date.format %]
 277
 278 The plugin allows a time/date to be specified as seconds since the epoch,
 279 as is returned by C<time()>.
 280
 281     File last modified: [% date.format(filemod_time) %]
 282
 283 The time/date can also be specified as a string of the form C<h:m:s d/m/y>
 284 or C<y/m/d h:m:s>.  Any of the characters : / - or space may be used to
 285 delimit fields.
 286
 287     [% USE day = date(format => '%A', locale => 'en_GB') %]
 288     [% day.format('4:20:00 9-13-2000') %]
 289
 290 Output:
 291
 292     Tuesday
 293
 294 A format string can also be passed to the C<format()> method, and a locale
 295 specification may follow that.
 296
 297     [% date.format(filemod, '%d-%b-%Y') %]
 298     [% date.format(filemod, '%d-%b-%Y', 'en_GB') %]
 299
 300 A fourth parameter allows you to force output in GMT, in the case of
 301 seconds-since-the-epoch input:
 302
 303     [% date.format(filemod, '%d-%b-%Y', 'en_GB', 1) %]
 304
 305 Note 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
 307 misleading result.
 308
 309 Any or all of these parameters may be named.  Positional parameters
 310 should 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
 319 The C<now()> method returns the current system time in seconds since the
 320 epoch.
 321
 322     [% date.format(date.now, '%A') %]
 323
 324 The C<calc()> method can be used to create an interface to the C<Date::Calc>
 325 module (if installed on your system).
 326
 327     [% calc = date.calc %]
 328     [% calc.Monday_of_Week(22, 2001).join('/') %]
 329
 330 The C<manip()> method can be used to create an interface to the C<Date::Manip>
 331 module (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
 338 Thierry-Michel Barral wrote the original plugin.
 339
 340 Andy Wardley provided some minor
 341 fixups/enhancements, a test script and documentation.
 342
 343 Mark D. Mills cloned C<Date::Manip> from the C<Date::Calc> sub-plugin.
 344
 345 =head1 COPYRIGHT
 346
 347 Copyright (C) 2000-2007 Thierry-Michel Barral, Andy Wardley.
 348
 349 This module is free software; you can redistribute it and/or
 350 modify it under the same terms as Perl itself.
 351
 352 =head1 SEE ALSO
 353
 354 L<Template::Plugin>, L<POSIX>
 355