Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Date::Format $Id: //depot/TimeDate/lib/Date/Format.pm#8 $ |
2 | # | |
3 | # Copyright (c) 1995-1999 Graham Barr. All rights reserved. This program is free | |
4 | # software; you can redistribute it and/or modify it under the same terms | |
5 | # as Perl itself. | |
6 | ||
7 | package Date::Format; | |
8 | ||
9 | use strict; | |
10 | use vars qw(@EXPORT @ISA $VERSION); | |
11 | require Exporter; | |
12 | ||
13 | $VERSION = "2.22"; | |
14 | @ISA = qw(Exporter); | |
15 | @EXPORT = qw(time2str strftime ctime asctime); | |
16 | ||
17 | sub time2str ($;$$) | |
18 | { | |
19 | Date::Format::Generic->time2str(@_); | |
20 | } | |
21 | ||
22 | sub strftime ($\@;$) | |
23 | { | |
24 | Date::Format::Generic->strftime(@_); | |
25 | } | |
26 | ||
27 | sub ctime ($;$) | |
28 | { | |
29 | my($t,$tz) = @_; | |
30 | Date::Format::Generic->time2str("%a %b %e %T %Y\n", $t, $tz); | |
31 | } | |
32 | ||
33 | sub asctime (\@;$) | |
34 | { | |
35 | my($t,$tz) = @_; | |
36 | Date::Format::Generic->strftime("%a %b %e %T %Y\n", $t, $tz); | |
37 | } | |
38 | ||
39 | ## | |
40 | ## | |
41 | ## | |
42 | ||
43 | package Date::Format::Generic; | |
44 | ||
45 | use vars qw($epoch $tzname); | |
46 | use Time::Zone; | |
47 | use Time::Local; | |
48 | ||
49 | sub ctime | |
50 | { | |
51 | my($me,$t,$tz) = @_; | |
52 | $me->time2str("%a %b %e %T %Y\n", $t, $tz); | |
53 | } | |
54 | ||
55 | sub asctime | |
56 | { | |
57 | my($me,$t,$tz) = @_; | |
58 | $me->strftime("%a %b %e %T %Y\n", $t, $tz); | |
59 | } | |
60 | ||
61 | sub _subs | |
62 | { | |
63 | my $fn; | |
64 | $_[1] =~ s/ | |
65 | %(O?[%a-zA-Z]) | |
66 | / | |
67 | ($_[0]->can("format_$1") || sub { $1 })->($_[0]); | |
68 | /sgeox; | |
69 | ||
70 | $_[1]; | |
71 | } | |
72 | ||
73 | sub strftime | |
74 | { | |
75 | my($pkg,$fmt,$time); | |
76 | ||
77 | ($pkg,$fmt,$time,$tzname) = @_; | |
78 | ||
79 | my $me = ref($pkg) ? $pkg : bless []; | |
80 | ||
81 | if(defined $tzname) | |
82 | { | |
83 | $tzname = uc $tzname; | |
84 | ||
85 | $tzname = sprintf("%+05d",$tzname) | |
86 | unless($tzname =~ /\D/); | |
87 | ||
88 | $epoch = timegm(@{$time}[0..5]); | |
89 | ||
90 | @$me = gmtime($epoch + tz_offset($tzname) - tz_offset()); | |
91 | } | |
92 | else | |
93 | { | |
94 | @$me = @$time; | |
95 | undef $epoch; | |
96 | } | |
97 | ||
98 | _subs($me,$fmt); | |
99 | } | |
100 | ||
101 | sub time2str | |
102 | { | |
103 | my($pkg,$fmt,$time); | |
104 | ||
105 | ($pkg,$fmt,$time,$tzname) = @_; | |
106 | ||
107 | my $me = ref($pkg) ? $pkg : bless [], $pkg; | |
108 | ||
109 | $epoch = $time; | |
110 | ||
111 | if(defined $tzname) | |
112 | { | |
113 | $tzname = uc $tzname; | |
114 | ||
115 | $tzname = sprintf("%+05d",$tzname) | |
116 | unless($tzname =~ /\D/); | |
117 | ||
118 | $time += tz_offset($tzname); | |
119 | @$me = gmtime($time); | |
120 | } | |
121 | else | |
122 | { | |
123 | @$me = localtime($time); | |
124 | } | |
125 | _subs($me,$fmt); | |
126 | } | |
127 | ||
128 | my(@DoW,@MoY,@DoWs,@MoYs,@AMPM,%format,@Dsuf); | |
129 | ||
130 | @DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); | |
131 | ||
132 | @MoY = qw(January February March April May June | |
133 | July August September October November December); | |
134 | ||
135 | @DoWs = map { substr($_,0,3) } @DoW; | |
136 | @MoYs = map { substr($_,0,3) } @MoY; | |
137 | ||
138 | @AMPM = qw(AM PM); | |
139 | ||
140 | @Dsuf = (qw(th st nd rd th th th th th th)) x 3; | |
141 | @Dsuf[11,12,13] = qw(th th th); | |
142 | @Dsuf[30,31] = qw(th st); | |
143 | ||
144 | %format = ('x' => "%m/%d/%y", | |
145 | 'C' => "%a %b %e %T %Z %Y", | |
146 | 'X' => "%H:%M:%S", | |
147 | ); | |
148 | ||
149 | my @locale; | |
150 | my $locale = "/usr/share/lib/locale/LC_TIME/default"; | |
151 | local *LOCALE; | |
152 | ||
153 | if(open(LOCALE,"$locale")) | |
154 | { | |
155 | chop(@locale = <LOCALE>); | |
156 | close(LOCALE); | |
157 | ||
158 | @MoYs = @locale[0 .. 11]; | |
159 | @MoY = @locale[12 .. 23]; | |
160 | @DoWs = @locale[24 .. 30]; | |
161 | @DoW = @locale[31 .. 37]; | |
162 | @format{"X","x","C"} = @locale[38 .. 40]; | |
163 | @AMPM = @locale[41 .. 42]; | |
164 | } | |
165 | ||
166 | sub wkyr { | |
167 | my($wstart, $wday, $yday) = @_; | |
168 | $wday = ($wday + 7 - $wstart) % 7; | |
169 | return int(($yday - $wday + 13) / 7 - 1); | |
170 | } | |
171 | ||
172 | ## | |
173 | ## these 6 formatting routins need to be *copied* into the language | |
174 | ## specific packages | |
175 | ## | |
176 | ||
177 | my @roman = ('',qw(I II III IV V VI VII VIII IX)); | |
178 | sub roman { | |
179 | my $n = shift; | |
180 | ||
181 | $n =~ s/(\d)$//; | |
182 | my $r = $roman[ $1 ]; | |
183 | ||
184 | if($n =~ s/(\d)$//) { | |
185 | (my $t = $roman[$1]) =~ tr/IVX/XLC/; | |
186 | $r = $t . $r; | |
187 | } | |
188 | if($n =~ s/(\d)$//) { | |
189 | (my $t = $roman[$1]) =~ tr/IVX/CDM/; | |
190 | $r = $t . $r; | |
191 | } | |
192 | if($n =~ s/(\d)$//) { | |
193 | (my $t = $roman[$1]) =~ tr/IVX/M../; | |
194 | $r = $t . $r; | |
195 | } | |
196 | $r; | |
197 | } | |
198 | ||
199 | sub format_a { $DoWs[$_[0]->[6]] } | |
200 | sub format_A { $DoW[$_[0]->[6]] } | |
201 | sub format_b { $MoYs[$_[0]->[4]] } | |
202 | sub format_B { $MoY[$_[0]->[4]] } | |
203 | sub format_h { $MoYs[$_[0]->[4]] } | |
204 | sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] } | |
205 | sub format_P { lc($_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0]) } | |
206 | ||
207 | sub format_d { sprintf("%02d",$_[0]->[3]) } | |
208 | sub format_e { sprintf("%2d",$_[0]->[3]) } | |
209 | sub format_H { sprintf("%02d",$_[0]->[2]) } | |
210 | sub format_I { sprintf("%02d",$_[0]->[2] % 12 || 12)} | |
211 | sub format_j { sprintf("%03d",$_[0]->[7] + 1) } | |
212 | sub format_k { sprintf("%2d",$_[0]->[2]) } | |
213 | sub format_l { sprintf("%2d",$_[0]->[2] % 12 || 12)} | |
214 | sub format_L { $_[0]->[4] + 1 } | |
215 | sub format_m { sprintf("%02d",$_[0]->[4] + 1) } | |
216 | sub format_M { sprintf("%02d",$_[0]->[1]) } | |
217 | sub format_q { sprintf("%01d",int($_[0]->[4] / 3) + 1) } | |
218 | sub format_s { | |
219 | $epoch = timegm(@{$_[0]}[0..5]) | |
220 | unless defined $epoch; | |
221 | sprintf("%d",$epoch) | |
222 | } | |
223 | sub format_S { sprintf("%02d",$_[0]->[0]) } | |
224 | sub format_U { wkyr(0, $_[0]->[6], $_[0]->[7]) } | |
225 | sub format_w { $_[0]->[6] } | |
226 | sub format_W { wkyr(1, $_[0]->[6], $_[0]->[7]) } | |
227 | sub format_y { sprintf("%02d",$_[0]->[5] % 100) } | |
228 | sub format_Y { sprintf("%04d",$_[0]->[5] + 1900) } | |
229 | ||
230 | sub format_Z { | |
231 | my $o = tz_local_offset(timelocal(@{$_[0]}[0..5])); | |
232 | defined $tzname ? $tzname : uc tz_name($o, $_[0]->[8]); | |
233 | } | |
234 | ||
235 | sub format_z { | |
236 | my $t = timelocal(@{$_[0]}[0..5]); | |
237 | my $o = defined $tzname ? tz_offset($tzname, $t) : tz_offset(undef,$t); | |
238 | sprintf("%+03d%02d", int($o / 3600), abs(int($o % 3600))); | |
239 | } | |
240 | ||
241 | sub format_c { &format_x . " " . &format_X } | |
242 | sub format_D { &format_m . "/" . &format_d . "/" . &format_y } | |
243 | sub format_r { &format_I . ":" . &format_M . ":" . &format_S . " " . &format_p } | |
244 | sub format_R { &format_H . ":" . &format_M } | |
245 | sub format_T { &format_H . ":" . &format_M . ":" . &format_S } | |
246 | sub format_t { "\t" } | |
247 | sub format_n { "\n" } | |
248 | sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]]) } | |
249 | sub format_x { my $f = $format{'x'}; _subs($_[0],$f); } | |
250 | sub format_X { my $f = $format{'X'}; _subs($_[0],$f); } | |
251 | sub format_C { my $f = $format{'C'}; _subs($_[0],$f); } | |
252 | ||
253 | sub format_Od { roman(format_d(@_)) } | |
254 | sub format_Oe { roman(format_e(@_)) } | |
255 | sub format_OH { roman(format_H(@_)) } | |
256 | sub format_OI { roman(format_I(@_)) } | |
257 | sub format_Oj { roman(format_j(@_)) } | |
258 | sub format_Ok { roman(format_k(@_)) } | |
259 | sub format_Ol { roman(format_l(@_)) } | |
260 | sub format_Om { roman(format_m(@_)) } | |
261 | sub format_OM { roman(format_M(@_)) } | |
262 | sub format_Oq { roman(format_q(@_)) } | |
263 | sub format_Oy { roman(format_y(@_)) } | |
264 | sub format_OY { roman(format_Y(@_)) } | |
265 | ||
266 | 1; | |
267 | __END__ | |
268 | ||
269 | =head1 NAME | |
270 | ||
271 | Date::Format - Date formating subroutines | |
272 | ||
273 | =head1 SYNOPSIS | |
274 | ||
275 | use Date::Format; | |
276 | ||
277 | @lt = localtime(time); | |
278 | ||
279 | print time2str($template, time); | |
280 | print strftime($template, @lt); | |
281 | ||
282 | print time2str($template, time, $zone); | |
283 | print strftime($template, @lt, $zone); | |
284 | ||
285 | print ctime(time); | |
286 | print asctime(@lt); | |
287 | ||
288 | print ctime(time, $zone); | |
289 | print asctime(@lt, $zone); | |
290 | ||
291 | =head1 DESCRIPTION | |
292 | ||
293 | This module provides routines to format dates into ASCII strings. They | |
294 | correspond to the C library routines C<strftime> and C<ctime>. | |
295 | ||
296 | =over 4 | |
297 | ||
298 | =item time2str(TEMPLATE, TIME [, ZONE]) | |
299 | ||
300 | C<time2str> converts C<TIME> into an ASCII string using the conversion | |
301 | specification given in C<TEMPLATE>. C<ZONE> if given specifies the zone | |
302 | which the output is required to be in, C<ZONE> defaults to your current zone. | |
303 | ||
304 | ||
305 | =item strftime(TEMPLATE, TIME [, ZONE]) | |
306 | ||
307 | C<strftime> is similar to C<time2str> with the exception that the time is | |
308 | passed as an array, such as the array returned by C<localtime>. | |
309 | ||
310 | =item ctime(TIME [, ZONE]) | |
311 | ||
312 | C<ctime> calls C<time2str> with the given arguments using the | |
313 | conversion specification C<"%a %b %e %T %Y\n"> | |
314 | ||
315 | =item asctime(TIME [, ZONE]) | |
316 | ||
317 | C<asctime> calls C<time2str> with the given arguments using the | |
318 | conversion specification C<"%a %b %e %T %Y\n"> | |
319 | ||
320 | =back | |
321 | ||
322 | =head1 MULTI-LANGUAGE SUPPORT | |
323 | ||
324 | Date::Format is capable of formating into several languages, these are | |
325 | English, French, German and Italian. Changing the language is done via | |
326 | a static method call, for example | |
327 | ||
328 | Date::Format->language('German'); | |
329 | ||
330 | will change the language in which all subsequent dates are formatted. | |
331 | ||
332 | This is only a first pass, I am considering changing this to be | |
333 | ||
334 | $lang = Date::Language->new('German'); | |
335 | $lang->time2str("%a %b %e %T %Y\n", time); | |
336 | ||
337 | I am open to suggestions on this. | |
338 | ||
339 | =head1 CONVERSION SPECIFICATION | |
340 | ||
341 | Each conversion specification is replaced by appropriate | |
342 | characters as described in the following list. The | |
343 | appropriate characters are determined by the LC_TIME | |
344 | category of the program's locale. | |
345 | ||
346 | %% PERCENT | |
347 | %a day of the week abbr | |
348 | %A day of the week | |
349 | %b month abbr | |
350 | %B month | |
351 | %c MM/DD/YY HH:MM:SS | |
352 | %C ctime format: Sat Nov 19 21:05:57 1994 | |
353 | %d numeric day of the month, with leading zeros (eg 01..31) | |
354 | %e numeric day of the month, without leading zeros (eg 1..31) | |
355 | %D MM/DD/YY | |
356 | %h month abbr | |
357 | %H hour, 24 hour clock, leading 0's) | |
358 | %I hour, 12 hour clock, leading 0's) | |
359 | %j day of the year | |
360 | %k hour | |
361 | %l hour, 12 hour clock | |
362 | %L month number, starting with 1 | |
363 | %m month number, starting with 01 | |
364 | %M minute, leading 0's | |
365 | %n NEWLINE | |
366 | %o ornate day of month -- "1st", "2nd", "25th", etc. | |
367 | %p AM or PM | |
368 | %P am or pm (Yes %p and %P are backwards :) | |
369 | %q Quarter number, starting with 1 | |
370 | %r time format: 09:05:57 PM | |
371 | %R time format: 21:05 | |
372 | %s seconds since the Epoch, UCT | |
373 | %S seconds, leading 0's | |
374 | %t TAB | |
375 | %T time format: 21:05:57 | |
376 | %U week number, Sunday as first day of week | |
377 | %w day of the week, numerically, Sunday == 0 | |
378 | %W week number, Monday as first day of week | |
379 | %x date format: 11/19/94 | |
380 | %X time format: 21:05:57 | |
381 | %y year (2 digits) | |
382 | %Y year (4 digits) | |
383 | %Z timezone in ascii. eg: PST | |
384 | %z timezone in format -/+0000 | |
385 | ||
386 | C<%d>, C<%e>, C<%H>, C<%I>, C<%j>, C<%k>, C<%l>, C<%m>, C<%M>, C<%q>, | |
387 | C<%y> and C<%Y> can be output in Roman numerals by prefixing the letter | |
388 | with C<O>, e.g. C<%OY> will output the year as roman numerals. | |
389 | ||
390 | =head1 AUTHOR | |
391 | ||
392 | Graham Barr <gbarr@pobox.com> | |
393 | ||
394 | =head1 COPYRIGHT | |
395 | ||
396 | Copyright (c) 1995-1999 Graham Barr. All rights reserved. This program is free | |
397 | software; you can redistribute it and/or modify it under the same terms | |
398 | as Perl itself. | |
399 | ||
400 | =cut | |
401 | ||
402 |