File Coverage

blib/lib/Date/Format.pm
Criterion Covered Total %
statement 117 131 89.3
branch 19 28 67.8
condition 4 6 66.6
subroutine 62 68 91.1
pod 4 4 100.0
total 206 237 86.9


line stmt bran cond sub pod time code
1             # Copyright (c) 1995-2009 Graham Barr. This program is free
2             # software; you can redistribute it and/or modify it under the same terms
3             # as Perl itself.
4              
5             package Date::Format;
6              
7 4     4   56101 use strict;
  4         13  
  4         130  
8 4     4   20 use vars qw(@EXPORT @ISA $VERSION);
  4         6  
  4         785  
9             require Exporter;
10              
11             $VERSION = "2.24";
12             @ISA = qw(Exporter);
13             @EXPORT = qw(time2str strftime ctime asctime);
14              
15             sub time2str ($;$$)
16             {
17 150     150 1 834 Date::Format::Generic->time2str(@_);
18             }
19              
20             sub strftime ($\@;$)
21             {
22 1     1 1 102 Date::Format::Generic->strftime(@_);
23             }
24              
25             sub ctime ($;$)
26             {
27 0     0 1 0 my($t,$tz) = @_;
28 0         0 Date::Format::Generic->time2str("%a %b %e %T %Y\n", $t, $tz);
29             }
30              
31             sub asctime (\@;$)
32             {
33 0     0 1 0 my($t,$tz) = @_;
34 0         0 Date::Format::Generic->strftime("%a %b %e %T %Y\n", $t, $tz);
35             }
36              
37             ##
38             ##
39             ##
40              
41             package Date::Format::Generic;
42              
43 4     4   22 use vars qw($epoch $tzname);
  4         15  
  4         169  
44 4     4   1125 use Time::Zone;
  4         8  
  4         229  
45 4     4   849 use Time::Local;
  4         3660  
  4         8517  
46              
47             sub ctime
48             {
49 4     4   38 my($me,$t,$tz) = @_;
50 4         13 $me->time2str("%a %b %e %T %Y\n", $t, $tz);
51             }
52              
53             sub asctime
54             {
55 0     0   0 my($me,$t,$tz) = @_;
56 0         0 $me->strftime("%a %b %e %T %Y\n", $t, $tz);
57             }
58              
59             sub _subs
60             {
61 377     377   436 my $fn;
62 377         1829 $_[1] =~ s/
63             %(O?[%a-zA-Z])
64             /
65 1182   100 4   5260 ($_[0]->can("format_$1") || sub { $1 })->($_[0]);
  4         14  
66             /sgeox;
67              
68 377         1329 $_[1];
69             }
70              
71             sub strftime
72             {
73 1     1   2 my($pkg,$fmt,$time);
74              
75 1         3 ($pkg,$fmt,$time,$tzname) = @_;
76              
77 1 50       4 my $me = ref($pkg) ? $pkg : bless [];
78              
79 1 50       3 if(defined $tzname)
80             {
81 0         0 $tzname = uc $tzname;
82              
83 0 0       0 $tzname = sprintf("%+05d",$tzname)
84             unless($tzname =~ /\D/);
85              
86 0         0 $epoch = timegm(@{$time}[0..5]);
  0         0  
87              
88 0         0 @$me = gmtime($epoch + tz_offset($tzname) - tz_offset());
89             }
90             else
91             {
92 1         3 @$me = @$time;
93 1         2 undef $epoch;
94             }
95              
96 1         2 _subs($me,$fmt);
97             }
98              
99             sub time2str
100             {
101 356     356   87779 my($pkg,$fmt,$time);
102              
103 356         648 ($pkg,$fmt,$time,$tzname) = @_;
104              
105 356 100       774 my $me = ref($pkg) ? $pkg : bless [], $pkg;
106              
107 356         484 $epoch = $time;
108              
109 356 100       515 if(defined $tzname)
110             {
111 351         507 $tzname = uc $tzname;
112              
113 351 50       1043 $tzname = sprintf("%+05d",$tzname)
114             unless($tzname =~ /\D/);
115              
116 351         764 $time += tz_offset($tzname);
117 351         1178 @$me = gmtime($time);
118             }
119             else
120             {
121 5         115 @$me = localtime($time);
122             }
123 356         697 $me->[9] = $time;
124 356         603 _subs($me,$fmt);
125             }
126              
127             my(@DoW,@MoY,@DoWs,@MoYs,@AMPM,%format,@Dsuf);
128              
129             @DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
130              
131             @MoY = qw(January February March April May June
132             July August September October November December);
133              
134             @DoWs = map { substr($_,0,3) } @DoW;
135             @MoYs = map { substr($_,0,3) } @MoY;
136              
137             @AMPM = qw(AM PM);
138              
139             @Dsuf = (qw(th st nd rd th th th th th th)) x 3;
140             @Dsuf[11,12,13] = qw(th th th);
141             @Dsuf[30,31] = qw(th st);
142              
143             %format = ('x' => "%m/%d/%y",
144             'C' => "%a %b %e %T %Z %Y",
145             'X' => "%H:%M:%S",
146             );
147              
148             my @locale;
149             my $locale = "/usr/share/lib/locale/LC_TIME/default";
150             local *LOCALE;
151              
152             if(open(LOCALE,"$locale"))
153             {
154             chop(@locale = );
155             close(LOCALE);
156              
157             @MoYs = @locale[0 .. 11];
158             @MoY = @locale[12 .. 23];
159             @DoWs = @locale[24 .. 30];
160             @DoW = @locale[31 .. 37];
161             @format{"X","x","C"} = @locale[38 .. 40];
162             @AMPM = @locale[41 .. 42];
163             }
164              
165             sub wkyr {
166 8     8   15 my($wstart, $wday, $yday) = @_;
167 8         24 $wday = ($wday + 7 - $wstart) % 7;
168 8         31 return int(($yday - $wday + 13) / 7 - 1);
169             }
170              
171             ##
172             ## these 6 formatting routins need to be *copied* into the language
173             ## specific packages
174             ##
175              
176             my @roman = ('',qw(I II III IV V VI VII VIII IX));
177             sub roman {
178 48     48   68 my $n = shift;
179              
180 48         133 $n =~ s/(\d)$//;
181 48         96 my $r = $roman[ $1 ];
182              
183 48 100       118 if($n =~ s/(\d)$//) {
184 35         68 (my $t = $roman[$1]) =~ tr/IVX/XLC/;
185 35         58 $r = $t . $r;
186             }
187 48 100       101 if($n =~ s/(\d)$//) {
188 8         15 (my $t = $roman[$1]) =~ tr/IVX/CDM/;
189 8         14 $r = $t . $r;
190             }
191 48 100       77 if($n =~ s/(\d)$//) {
192 4         9 (my $t = $roman[$1]) =~ tr/IVX/M../;
193 4         7 $r = $t . $r;
194             }
195 48         128 $r;
196             }
197              
198 149     149   505 sub format_a { $DoWs[$_[0]->[6]] }
199 1     1   4 sub format_A { $DoW[$_[0]->[6]] }
200 149     149   418 sub format_b { $MoYs[$_[0]->[4]] }
201 1     1   4 sub format_B { $MoY[$_[0]->[4]] }
202 1     1   4 sub format_h { $MoYs[$_[0]->[4]] }
203 5 100   5   25 sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
204 0 0   0   0 sub format_P { lc($_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0]) }
205              
206 20     20   87 sub format_d { sprintf("%02d",$_[0]->[3]) }
207 163     163   715 sub format_e { sprintf("%2d",$_[0]->[3]) }
208 179     179   489 sub format_H { sprintf("%02d",$_[0]->[2]) }
209 12   50 12   74 sub format_I { sprintf("%02d",$_[0]->[2] % 12 || 12)}
210 8     8   37 sub format_j { sprintf("%03d",$_[0]->[7] + 1) }
211 8     8   37 sub format_k { sprintf("%2d",$_[0]->[2]) }
212 8   50 8   53 sub format_l { sprintf("%2d",$_[0]->[2] % 12 || 12)}
213 4     4   15 sub format_L { $_[0]->[4] + 1 }
214 20     20   101 sub format_m { sprintf("%02d",$_[0]->[4] + 1) }
215 183     183   455 sub format_M { sprintf("%02d",$_[0]->[1]) }
216 8     8   51 sub format_q { sprintf("%01d",int($_[0]->[4] / 3) + 1) }
217             sub format_s {
218 6 100   6   20 $epoch = timelocal(@{$_[0]}[0..5])
  1         3  
219             unless defined $epoch;
220 6         80 sprintf("%d",$epoch)
221             }
222 175     175   567 sub format_S { sprintf("%02d",$_[0]->[0]) }
223 4     4   38 sub format_U { wkyr(0, $_[0]->[6], $_[0]->[7]) }
224 4     4   14 sub format_w { $_[0]->[6] }
225 4     4   13 sub format_W { wkyr(1, $_[0]->[6], $_[0]->[7]) }
226 23     23   101 sub format_y { sprintf("%02d",$_[0]->[5] % 100) }
227 166     166   655 sub format_Y { sprintf("%04d",$_[0]->[5] + 1900) }
228              
229             sub format_Z {
230 157     157   223 my $o = tz_local_offset(timelocal(@{$_[0]}[0..5]));
  157         404  
231 157 50       583 defined $tzname ? $tzname : uc tz_name($o, $_[0]->[8]);
232             }
233              
234             sub format_z {
235 7     7   13 my $t = timelocal(@{$_[0]}[0..5]);
  7         24  
236 7 50       332 my $o = defined $tzname ? tz_offset($tzname, $t) : tz_offset(undef,$t);
237 7         56 sprintf("%+03d%02d", int($o / 3600), int(abs($o) % 3600) / 60);
238             }
239              
240 4     4   15 sub format_c { &format_x . " " . &format_X }
241 4     4   9 sub format_D { &format_m . "/" . &format_d . "/" . &format_y }
242 4     4   10 sub format_r { &format_I . ":" . &format_M . ":" . &format_S . " " . &format_p }
243 4     4   14 sub format_R { &format_H . ":" . &format_M }
244 159     159   226 sub format_T { &format_H . ":" . &format_M . ":" . &format_S }
245 0     0   0 sub format_t { "\t" }
246 0     0   0 sub format_n { "\n" }
247 2     2   14 sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]]) }
248 8     8   20 sub format_x { my $f = $format{'x'}; _subs($_[0],$f); }
  8         24  
249 8     8   18 sub format_X { my $f = $format{'X'}; _subs($_[0],$f); }
  8         21  
250 4     4   10 sub format_C { my $f = $format{'C'}; _subs($_[0],$f); }
  4         10  
251              
252 4     4   15 sub format_Od { roman(format_d(@_)) }
253 4     4   14 sub format_Oe { roman(format_e(@_)) }
254 4     4   13 sub format_OH { roman(format_H(@_)) }
255 4     4   15 sub format_OI { roman(format_I(@_)) }
256 4     4   16 sub format_Oj { roman(format_j(@_)) }
257 4     4   14 sub format_Ok { roman(format_k(@_)) }
258 4     4   14 sub format_Ol { roman(format_l(@_)) }
259 4     4   13 sub format_Om { roman(format_m(@_)) }
260 4     4   13 sub format_OM { roman(format_M(@_)) }
261 4     4   54 sub format_Oq { roman(format_q(@_)) }
262 4     4   14 sub format_Oy { roman(format_y(@_)) }
263 4     4   13 sub format_OY { roman(format_Y(@_)) }
264              
265 3     3   13 sub format_G { int(($_[0]->[9] - 315993600) / 604800) }
266              
267             1;
268             __END__