home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / perl / 7446 / date.pl
Encoding:
Perl Script  |  1992-12-15  |  8.3 KB  |  246 lines
  1. ;#
  2. ;# Name
  3. ;#    date.pl - Perl emulation of (the output side of) date(1)
  4. ;#
  5. ;# Synopsis
  6. ;#    requirelude "date.pl";
  7. ;#    $Date = &date(time);
  8. ;#    $Date = &date(time, $format);
  9. ;#
  10. ;# Description
  11. ;#    This package implements the output formatting functions of date(1) in
  12. ;#    Perl.  The format options are based on those supported by Ultrix 4.0
  13. ;#    plus a couple of additions:
  14. ;#
  15. ;#        %a        abbreviated weekday name - Sun to Sat
  16. ;#        %A        full weekday name - Sunday to Saturday
  17. ;#        %b        abbreviated month name - Jan to Dec
  18. ;#        %B        full month name - January to December
  19. ;#        %c        date and time in local format [+]
  20. ;#        %d        day of month - 01 to 31
  21. ;#        %D        date as mm/dd/yy
  22. ;#        %e        day of month (space padded) - ` 1' to `31'
  23. ;#        %h        abbreviated month name - Jan to Dec
  24. ;#        %H        hour - 00 to 23
  25. ;#        %I        hour - 01 to 12
  26. ;#        %j        day of the year (Julian date) - 001 to 366
  27. ;#        %m        month of year - 01 to 12
  28. ;#        %M        minute - 00 to 59
  29. ;#        %n        insert a newline character
  30. ;#        %p        AM or PM
  31. ;#        %r        time in AM/PM notation
  32. ;#        %R        time as HH:MM
  33. ;#        %S        second - 00 to 59
  34. ;#        %t        insert a tab character
  35. ;#        %T        time as HH:MM:SS
  36. ;#        %U        week number, Sunday as first day of week - 00 to 53
  37. ;#        %w        day of week - 0 (Sunday) to 6
  38. ;#        %W        week number, Monday as first day of week - 00 to 53
  39. ;#        %x        date in local format [+]
  40. ;#        %X        time in local format [+]
  41. ;#        %y        last 2 digits of year - 00 to 99
  42. ;#        %Y        all 4 digits of year ~ 1700 to 2000 odd ?
  43. ;#        %z        time zone from TZ environment variable w/ a trailing space [*]
  44. ;#        %Z        time zone from TZ environment variable
  45. ;#        %%        insert a `%' character
  46. ;#        %+        insert a `+' character [*]
  47. ;#
  48. ;#    [*]:  Not supported by date(1) but I wanted 'em.
  49. ;#    [+]:  These may need adjustment to fit local conventions, see below.
  50. ;#
  51. ;#    For the sake of compatibility, a leading `+' in the format
  52. ;#    specificaiton is removed if present.
  53. ;#
  54. ;# Remarks
  55. ;#    An extension of `ctime.pl' by Waldemar Kebsch (kebsch.pad@nixpbe.UUCP),
  56. ;#    as modified by Marion Hakanson (hakanson@ogicse.ogi.edu).
  57. ;#
  58. ;#  Unlike date(1), unknown format tags are silently replaced by "".
  59. ;#
  60. ;#  defaultTZ is a blatant hack, but I wanted to be able to get date(1)
  61. ;#    like behaviour by default and there does'nt seem to be an easy (read
  62. ;#    portable) way to get the local TZ name back...
  63. ;#
  64. ;#    For a cheap date, try...
  65. ;#
  66. ;#        #!/usr/local/bin/perl
  67. ;#        require "date.pl";
  68. ;#        exit print (&date(time, shift @ARGV) . "\n") ? 0 : 1;
  69. ;#
  70. ;#    This package is redistributable under the same terms as apply to
  71. ;#    the Perl 3.0 release.  See the COPYING file in your Perl kit for
  72. ;#    more information.
  73. ;#
  74. ;#    Please send any bug reports or comments to tmcgonigal@gvc.com
  75. ;#
  76. ;# Modification History
  77. ;#    Nmemonic    Version    Date        Who
  78. ;#
  79. ;#    NONE        none    02feb91        Terry McGonigal (tmcgonigal@gvc.com)
  80. ;#        Created from ctime.pl
  81. ;#
  82. ;#    NONE        none    07feb91        tmcgonigal
  83. ;#        Added some of Marion Hakanson (hakanson@ogicse.ogi.edu)'s ctime.pl
  84. ;#        TZ handling changes.
  85. ;#
  86. ;#    NONE        none    09feb91        tmcgonigal
  87. ;#        Corrected week number calculations.
  88. ;#
  89. ;# SccsId = "%W% %E%"
  90. ;#
  91. package date;
  92.  
  93. # Months of the year
  94. @MoY = ('January',    'Febuary',    'March',    'April',    'May',        'June',
  95.         'July',        'August',    'September','October',    'November', 'December');
  96.  
  97. # days of the week
  98. @DoW = ('Sunday',    'Monday',    'Tuesday',    'Wednesday',
  99.         'Thursday',    'Friday',    'Saturday');
  100.  
  101. # defaults
  102. $defaultTZ = 'EST';                    # time zone (hack!)
  103. $defaultFMT = '%a %h %e %T %z%Y';    # format (ala date(1))
  104.  
  105. # `local' formats
  106. $locTF = '%T';                        # time (as HH:MM:SS)
  107. $locDF = '%D';                        # date (as mm/dd/yy)
  108. $locDTF = '%a %b %d %T %Y';            # date/time (as dow mon dd HH:MM:SS yyy)
  109.  
  110. # Time zone info
  111. $TZ;                                # wkno needs this info too
  112.  
  113. # define the known format tags as associative keys with their associated
  114. # replacement strings as values.  Each replacement string should be
  115. # an eval-able expresion assigning a value to $rep.  These expressions are
  116. # eval-ed, then the value of $rep is substituted into the supplied
  117. # format (if any).
  118. %Tags = ( '%a', '($rep = $DoW[$wday])=~ s/^(...).*/\1/',# abbr. weekday name - Sun to Sat
  119.           '%A', '$rep = $DoW[$wday]',                    # full weekday name - Sunday to Saturday
  120.           '%b', '($rep = $MoY[$mon]) =~ s/^(...).*/\1/',# abbr. month name - Jan to Dec
  121.           '%B', '$rep = $MoY[$mon]',                    # full month name - January to December
  122.           '%c', '$rep = $locDTF; 1',                    # date/time in local format
  123.           '%d',    '$rep = &date\'pad($mday, 2, "0")',        # day of month - 01 to 31
  124.           '%D',    '$rep = \'%m/%d/%y\'',                    # date as mm/dd/yy
  125.           '%e', '$rep = &date\'pad($mday, 2, " ")',        # day of month (space padded) ` 1' to `31'
  126.           '%h', '$rep = \'%b\'',                        # abbr. month name (same as %b)
  127.           '%H',    '$rep = &date\'pad($hour, 2, "0")',        # hour - 00 to 23
  128.           '%I', '$rep = &date\'ampmH($hour)',            # hour - 01 to 12
  129.           '%j', '$rep = &date\'pad($yday+1, 3, "0")',    # Julian date 001 - 366
  130.           '%m',    '$rep = &date\'pad($mon+1, 2, "0")',    # month of year - 01 to 12
  131.           '%M', '$rep = &date\'pad($min, 2, "0")',        # minute - 00 to 59
  132.           '%n',    '$rep = "\n"',                            # insert a newline
  133.           '%p', '$rep = &date\'ampmD($hour)',            # insert `AM' or `PM'
  134.           '%r', '$rep = \'%I:%M:%S %p\'',                # time in AM/PM notation
  135.           '%R', '$rep = \'%H:%M\'',                        # time as HH:MM
  136.           '%S', '$rep = &date\'pad($sec, 2, "0")',        # second - 00 to 59
  137.           '%t',    '$rep = "\t"',                            # insert a tab
  138.           '%T',    '$rep = \'%H:%M:%S\'',                    # time as HH:MM:SS
  139.           '%U',    '$rep = &date\'wkno($yday, 0)',            # week number (weeks start on Sun) - 00 to 53
  140.           '%w', '$rep = $wday; 1',                        # day of week - Sunday = 0
  141.           '%W', '$rep = &date\'wkno($yday, 1)',            # week number (weeks start on Mon) - 00 to 53
  142.           '%x', '$rep = $locDF; 1',                        # date in local format
  143.           '%X', '$rep = $locTF; 1',                        # time in local format
  144.           '%y', '($rep = "$year") =~ s/..(..)/\1/',        # last 2 digits of year - 00 to 99
  145.           '%Y', '$rep = "$year"',                        # full year ~ 1700 to 2000 odd
  146.           '%z', '$rep = $TZ eq "" ? "" : "$TZ "',        # time zone from TZ env var (w/trail. space)
  147.           '%Z', '$rep = $TZ; 1',                        # time zone from TZ env. var.
  148.           '%%', '$rep = \'%\'; $adv=1',                    # insert a `%'
  149.           '%+', '$rep = \'+\''                            # insert a `+'
  150. );
  151.     
  152. sub main'date {
  153.     local($time, $format) = @_;
  154.     local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
  155.     local($pos, $tag, $rep, $adv) = (0, "", "", 0);
  156.  
  157.  
  158.     # default to date/ctime format or strip leading `+'...
  159.     if ($format eq "") {
  160.         $format = $defaultFMT;
  161.     } elsif ($format =~ /^\+/) {
  162.         $format = $';
  163.     }
  164.  
  165.     # Use local time if can't find a TZ in the environment
  166.     $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ;
  167.     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
  168.         &gettime ($TZ, $time);
  169.  
  170.     # Hack to deal with 'PST8PDT' format of TZ
  171.     # Note that this can't deal with all the esoteric forms, but it
  172.     # does recognize the most common: [:]STDoff[DST[off][,rule]]
  173.     if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
  174.         $TZ = $isdst ? $4 : $1;
  175.     }
  176.  
  177.     # watch out in 2070...
  178.     $year += ($year < 70) ? 2000 : 1900;
  179.  
  180.     # now loop throught the supplied format looking for tags...
  181.     while (($pos = index ($format, '%')) != -1) {
  182.  
  183.         # grab the format tag
  184.         $tag = substr($format, $pos, 2);
  185.         $adv = 0;                            # for `%%' processing
  186.  
  187.         # do we have a replacement string?
  188.         if (defined $Tags{$tag}) {
  189.  
  190.             # trap dead evals...
  191.             if (! eval $Tags{$tag}) {
  192.                 print STDERR "date.pl: internal error: eval for $tag failed.\n";
  193.                 return "";
  194.             }
  195.         } else {
  196.             $rep = "";
  197.         }
  198.             
  199.         # do the substitution
  200.         substr ($format, $pos, 2) =~ s/$tag/$rep/;
  201.         $pos++ if ($adv);
  202.     }
  203.  
  204.     $format;
  205. }
  206.  
  207. # weekno - figure out week number
  208. sub wkno {
  209.     local ($yday, $firstweekday) = @_;   
  210.     local ($jan1, @jan1, $wks);
  211.     local ($now) = time;
  212.  
  213.     # figure out the `time' value for January 1
  214.     $jan1 = $now - ((&gettime ($TZ, $now))[7] * 86400);        # 86400 sec/day
  215.  
  216.     # figure out what day of the week January 1 was
  217.     @jan1= &gettime ($TZ, $jan1);
  218.     
  219.     # and calculate the week number
  220.     $wks = (($yday + ($jan1[6] - $firstweekday)) + 1)/ 7;
  221.     $wks += (($wks - int($wks) > 0.0) ? 1 : 0);
  222.  
  223.     # supply zero padding
  224.     &pad (int($wks), 2, "0");
  225. }
  226.  
  227. # ampmH - figure out am/pm (1 - 12) mode hour value.
  228. sub ampmH { local ($h) = @_;  &pad($h>12 ? $h-12 : $h, 2, "0"); }
  229.  
  230. # ampmD - figure out am/pm designator
  231. sub ampmD { shift @_ > 12 ? "PM" : "AM"; }
  232.  
  233. # gettime - get the time via {local,gmt}time
  234. sub gettime { ((shift @_) eq 'GMT') ? gmtime(shift @_) : localtime(shift @_); }
  235.  
  236. # pad - pad $in with leading $pad until lenght $len
  237. sub pad {
  238.     local ($in, $len, $pad) = @_;
  239.     local ($out) = "$in";
  240.  
  241.     $out = $pad . $out until (length ($out) == $len);
  242.     return $out;
  243. }
  244.  
  245. 1;
  246.