home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Date.pm < prev    next >
Encoding:
Perl POD Document  |  2002-09-20  |  6.1 KB  |  229 lines
  1. package Apache::ASP::Date;
  2.  
  3. # This package code was taken from HTTP::Date, written by Gisle Aas
  4. # Copyright 1995-1997, Gisle Aas
  5. # This library is free software; you can redistribute it and/or
  6. # modify it under the same terms as Perl itself.
  7.  
  8. use strict;
  9. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  10.  
  11. require 5.002;
  12. require Exporter;
  13. @ISA = qw(Exporter);
  14. @EXPORT = qw(time2str str2time);
  15. @EXPORT_OK = qw(time2iso time2isoz);
  16.  
  17. use Time::Local ();
  18.  
  19. use strict;
  20. use vars qw(@DoW @MoY %MoY);
  21.  
  22. #@DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
  23. @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
  24. @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  25. # Build %MoY hash
  26. my $i = 0;
  27. foreach(@MoY) {
  28.    $MoY{lc $_} = $i++;
  29. }
  30.  
  31. my($current_month, $current_year) = (localtime)[4, 5];
  32.  
  33.  
  34. sub time2str (;$)
  35. {
  36.    my $time = shift;
  37.    $time = time unless defined $time;
  38.    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
  39.    sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
  40.        $DoW[$wday],
  41.        $mday, $MoY[$mon], $year+1900,
  42.        $hour, $min, $sec);
  43. }
  44.  
  45.  
  46.  
  47. sub str2time ($;$)
  48. {
  49.    local($_) = shift;
  50.    return undef unless defined;
  51.    my($default_zone) = @_;
  52.  
  53.    # Remove useless weekday, if it exists
  54.    s/^\s*(?:sun|mon|tue|wed|thu|fri|sat)\w*,?\s*//i;
  55.  
  56.    my($day, $mon, $yr, $hr, $min, $sec, $tz, $aorp);
  57.    my $offset = 0;  # used when compensating for timezone
  58.  
  59.  PARSEDATE: {
  60.       # Then we are able to check for most of the formats with this regexp
  61.       ($day,$mon,$yr,$hr,$min,$sec,$tz) =
  62.     /^\s*
  63.      (\d\d?)               # day
  64.         (?:\s+|[-\/])
  65.      (\w+)                 # month
  66.         (?:\s+|[-\/])
  67.      (\d+)                 # year
  68.      (?:
  69.            (?:\s+|:)       # separator before clock
  70.         (\d\d?):(\d\d)     # hour:min
  71.         (?::(\d\d))?       # optional seconds
  72.      )?                    # optional clock
  73.         \s*
  74.      ([-+]?\d{2,4}|GMT|gmt)? # timezone
  75.         \s*$
  76.     /x
  77.       and last PARSEDATE;
  78.  
  79.       # Try the ctime and asctime format
  80.       ($mon, $day, $hr, $min, $sec, $tz, $yr) =
  81.     /^\s*                  # allow intial whitespace
  82.      (\w{1,3})             # month
  83.         \s+
  84.      (\d\d?)               # day
  85.         \s+
  86.      (\d\d?):(\d\d)        # hour:min
  87.      (?::(\d\d))?          # optional seconds
  88.         \s+
  89.      (?:(GMT|gmt)\s+)?     # optional GMT timezone
  90.      (\d+)                 # year
  91.         \s*$               # allow trailing whitespace
  92.     /x
  93.       and last PARSEDATE;
  94.  
  95.       # Then the Unix 'ls -l' date format
  96.       ($mon, $day, $yr, $hr, $min, $sec) =
  97.     /^\s*
  98.      (\w{3})               # month
  99.         \s+
  100.      (\d\d?)               # day
  101.         \s+
  102.      (?:
  103.         (\d\d\d\d) |       # year
  104.         (\d{1,2}):(\d{2})  # hour:min
  105.             (?::(\d\d))?       # optional seconds
  106.      )
  107.      \s*$
  108.        /x
  109.      and last PARSEDATE;
  110.  
  111.       # ISO 8601 format '1996-02-29 12:00:00 -0100' and variants
  112.       ($yr, $mon, $day, $hr, $min, $sec, $tz) =
  113.     /^\s*
  114.       (\d{4})              # year
  115.          [-\/]?
  116.       (\d\d?)              # numerical month
  117.          [-\/]?
  118.       (\d\d?)              # day
  119.      (?:
  120.            (?:\s+|:|T|-)   # separator before clock
  121.         (\d\d?):?(\d\d)    # hour:min
  122.         (?::?(\d\d))?      # optional seconds
  123.      )?                    # optional clock
  124.         \s*
  125.      ([-+]?\d\d?:?(:?\d\d)?
  126.       |Z|z)?               # timezone  (Z is "zero meridian", i.e. GMT)
  127.         \s*$
  128.     /x
  129.       and last PARSEDATE;
  130.  
  131.       # Windows 'dir' 11-12-96  03:52PM
  132.       ($mon, $day, $yr, $hr, $min, $aorp) =
  133.         /^\s*
  134.           (\d{2})                # numerical month
  135.              -
  136.           (\d{2})                # day
  137.              -
  138.           (\d{2})                # year
  139.              \s+
  140.           (\d\d?):(\d\d)([apAP][mM])  # hour:min AM or PM
  141.              \s*$
  142.         /x
  143.           and last PARSEDATE;
  144.  
  145.       # If it is not recognized by now we give up
  146.       return undef;
  147.    }
  148.  
  149.    # Translate month name to number
  150.    if ($mon =~ /^\d+$/) {
  151.      # numeric month
  152.      return undef if $mon < 1 || $mon > 12;
  153.      $mon--;
  154.    } else {
  155.      $mon = lc $mon;
  156.      return undef unless exists $MoY{$mon};
  157.      $mon = $MoY{$mon};
  158.    }
  159.  
  160.    # If the year is missing, we assume some date before the current,
  161.    # because these date are mostly present on "ls -l" listings.
  162.    unless (defined $yr) {
  163.     $yr = $current_year;
  164.     $yr-- if $mon > $current_month;
  165.     }
  166.  
  167.    # Then we check if the year is acceptable
  168.    return undef if $yr > 99 && $yr < 1900;  # We ignore these years
  169.    $yr += 100 if $yr < 50;  # a stupid thing to do???
  170.    $yr -= 1900 if $yr >= 1900;
  171.    # The $yr is now relative to 1900 (as expected by timelocal())
  172.  
  173.    # timelocal() seems to go into an infinite loop if it is given out
  174.    # of range parameters.  Let's check the year at least.
  175.  
  176.    # Epoch counter maxes out in year 2038, assuming "time_t" is 32 bit
  177.    return undef if $yr > 138;
  178.    return undef if $yr <  70;  # 1970 is Unix epoch
  179.  
  180.    # Compensate for AM/PM
  181.    if ($aorp) {
  182.        $aorp = uc $aorp;
  183.        $hr = 0 if $hr == 12 && $aorp eq 'AM';
  184.        $hr += 12 if $aorp eq 'PM' && $hr != 12;
  185.    }
  186.  
  187.    # Make sure things are defined
  188.    for ($sec, $min, $hr) {  $_ = 0 unless defined   }
  189.  
  190.    # Should we compensate for the timezone?
  191.    $tz = $default_zone unless defined $tz;
  192.    return eval {Time::Local::timelocal($sec, $min, $hr, $day, $mon, $yr)}
  193.      unless defined $tz;
  194.  
  195.    # We can calculate offset for numerical time zones
  196.    if ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) {
  197.        $offset = 3600 * $2;
  198.        $offset += 60 * $3 if $3;
  199.        $offset *= -1 if $1 && $1 ne '-';
  200.    }
  201.    eval{Time::Local::timegm($sec, $min, $hr, $day, $mon, $yr) + $offset};
  202. }
  203.  
  204.  
  205.  
  206. # And then some bloat because I happen to like the ISO 8601 time
  207. # format.
  208.  
  209. sub time2iso (;$)
  210. {
  211.    my $time = shift;
  212.    $time = time unless defined $time;
  213.    my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
  214.    sprintf("%04d-%02d-%02d %02d:%02d:%02d",
  215.        $year+1900, $mon+1, $mday, $hour, $min, $sec);
  216. }
  217.  
  218.  
  219. sub time2isoz (;$)
  220. {
  221.     my $time = shift;
  222.     $time = time unless defined $time;
  223.     my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time);
  224.     sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
  225.             $year+1900, $mon+1, $mday, $hour, $min, $sec);
  226. }
  227.  
  228. 1;
  229.