File Coverage

lib/Template/Plugin/Date.pm
Criterion Covered Total %
statement 63 94 67.0
branch 20 36 55.5
condition 9 15 60.0
subroutine 13 18 72.2
pod 1 6 16.6
total 106 169 62.7


line stmt bran cond sub pod time code
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
11             # Andy Wardley
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 1     1   517 use strict;
  1         2  
  1         31  
24 1     1   7 use warnings;
  1         3  
  1         26  
25 1     1   5 use base 'Template::Plugin';
  1         2  
  1         419  
26              
27 1     1   968 use POSIX ();
  1         10032  
  1         34  
28              
29 1     1   9 use Config ();
  1         1  
  1         33  
30              
31 1     1   6 use constant HAS_SETLOCALE => $Config::Config{d_setlocale};
  1         4  
  1         1197  
32              
33             our $VERSION = 2.78;
34             our $FORMAT = '%H:%M:%S %d-%b-%Y'; # default strftime() format
35             our @LOCALE_SUFFIX = qw( .ISO8859-1 .ISO_8859-15 .US-ASCII .UTF-8 );
36              
37              
38             #------------------------------------------------------------------------
39             # new(\%options)
40             #------------------------------------------------------------------------
41              
42             sub new {
43 19     19 1 31 my ($class, $context, $params) = @_;
44 19 100       156 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              
56             sub now {
57 5     5 0 23 return time();
58             }
59              
60              
61             #------------------------------------------------------------------------
62             # format()
63             # format($time)
64             # format($time, $format)
65             # format($time, $format, $locale)
66             # format($time, $format, $locale, $gmt_flag)
67             # format(\%named_params);
68             #
69             # Returns a formatted time/date string for the specified time, $time,
70             # (or the current system time if unspecified) using the $format, $locale,
71             # and $gmt values specified as arguments or internal values set defined
72             # at construction time). Specifying a Perl-true value for $gmt will
73             # override the local time zone and force the output to be for GMT.
74             # Any or all of the arguments may be specified as named parameters which
75             # get passed as a hash array reference as the final argument.
76             # ------------------------------------------------------------------------
77              
78             sub format {
79 19     19 0 146 my $self = shift;
80 19 100       89 my $params = ref($_[$#_]) eq 'HASH' ? pop(@_) : { };
81             my $time = shift(@_) || $params->{ time } || $self->{ time }
82 19   66     178 || $self->now();
83             my $format = @_ ? shift(@_)
84 19 100 66     114 : ($params->{ format } || $self->{ format } || $FORMAT);
85             my $locale = @_ ? shift(@_)
86 19 50 100     115 : ($params->{ locale } || $self->{ locale });
87             my $gmt = @_ ? shift(@_)
88 19 50 33     99 : ($params->{ gmt } || $self->{ gmt });
89 19         30 my (@date, $datestr);
90              
91 19 100       120 if ($time =~ /^-?\d+$/) {
92             # $time is now in seconds since epoch
93 12 50       27 if ($gmt) {
94 0         0 @date = (gmtime($time))[0..6];
95             }
96             else {
97 12         520 @date = (localtime($time))[0..6];
98             }
99             }
100             else {
101             # if $time is numeric, then we assume it's seconds since the epoch
102             # otherwise, we try to parse it as either a 'Y:M:D H:M:S' or a
103             # 'H:M:S D:M:Y' string
104              
105 7         61 my @parts = (split(/\D/, $time));
106              
107 7 100       23 if (@parts >= 6) {
108 6 100       14 if (length($parts[0]) == 4) {
109             # year is first; assume 'Y:M:D H:M:S'
110 3         16 @date = @parts[reverse 0..5];
111             }
112             else {
113             # year is last; assume 'H:M:S D:M:Y'
114 3         18 @date = @parts[2,1,0,3..5];
115             }
116             }
117              
118 7 100       16 if (!@date) {
119 1         13 return (undef, Template::Exception->new('date',
120             "bad time/date string: " .
121             "expects 'h:m:s d:m:y' got: '$time'"));
122             }
123 6         16 $date[4] -= 1; # correct month number 1-12 to range 0-11
124 6         9 $date[5] -= 1900; # convert absolute year to years since 1900
125 6         367 $time = &POSIX::mktime(@date);
126             }
127            
128 18 100       47 if ($locale) {
129             # format the date in a specific locale, saving and subsequently
130             # restoring the current locale.
131 5         73 my $old_locale = HAS_SETLOCALE
132             ? &POSIX::setlocale(&POSIX::LC_ALL)
133             : undef;
134              
135             # some systems expect locales to have a particular suffix
136 5         16 for my $suffix ('', @LOCALE_SUFFIX) {
137 25         59 my $try_locale = $locale.$suffix;
138 25         186705 my $setlocale = HAS_SETLOCALE
139             ? &POSIX::setlocale(&POSIX::LC_ALL, $try_locale)
140             : undef;
141 25 50 33     123 if (defined $setlocale && $try_locale eq $setlocale) {
142 0         0 $locale = $try_locale;
143 0         0 last;
144             }
145             }
146 5         264 $datestr = &POSIX::strftime($format, @date);
147 5         52 &POSIX::setlocale(&POSIX::LC_ALL, $old_locale) if HAS_SETLOCALE;
148             }
149             else {
150 13         431 $datestr = &POSIX::strftime($format, @date);
151             }
152              
153 18         142 return $datestr;
154             }
155              
156             sub calc {
157 0     0 0   my $self = shift;
158 0           eval { require "Date/Calc.pm" };
  0            
159 0 0         $self->throw("failed to load Date::Calc: $@") if $@;
160 0           return Template::Plugin::Date::Calc->new('no context');
161             }
162              
163             sub manip {
164 0     0 0   my $self = shift;
165 0           eval { require "Date/Manip.pm" };
  0            
166 0 0         $self->throw("failed to load Date::Manip: $@") if $@;
167 0           return Template::Plugin::Date::Manip->new('no context');
168             }
169              
170              
171             sub throw {
172 0     0 0   my $self = shift;
173 0           die (Template::Exception->new('date', join(', ', @_)));
174             }
175              
176              
177             package Template::Plugin::Date::Calc;
178 1     1   4232 use base qw( Template::Plugin );
  1         3  
  1         93  
179 1     1   14 use vars qw( $AUTOLOAD );
  1         2  
  1         173  
180             *throw = \&Template::Plugin::Date::throw;
181              
182             sub AUTOLOAD {
183 0     0     my $self = shift;
184 0           my $method = $AUTOLOAD;
185              
186 0           $method =~ s/.*:://;
187 0 0         return if $method eq 'DESTROY';
188              
189 0           my $sub = \&{"Date::Calc::$method"};
  0            
190 0 0         $self->throw("no such Date::Calc method: $method")
191             unless $sub;
192              
193 0           &$sub(@_);
194             }
195              
196             package Template::Plugin::Date::Manip;
197 1     1   5 use base qw( Template::Plugin );
  1         2  
  1         69  
198 1     1   6 use vars qw( $AUTOLOAD );
  1         2  
  1         166  
199             *throw = \&Template::Plugin::Date::throw;
200              
201             sub AUTOLOAD {
202 0     0     my $self = shift;
203 0           my $method = $AUTOLOAD;
204            
205 0           $method =~ s/.*:://;
206 0 0         return if $method eq 'DESTROY';
207            
208 0           my $sub = \&{"Date::Manip::$method"};
  0            
209 0 0         $self->throw("no such Date::Manip method: $method")
210             unless $sub;
211            
212 0           &$sub(@_);
213             }
214            
215            
216             1;
217              
218             __END__