| 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 | |