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