home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Calc.pm < prev    next >
Encoding:
Perl POD Document  |  2002-09-29  |  8.1 KB  |  319 lines
  1.  
  2. ###############################################################################
  3. ##                                                                           ##
  4. ##    Copyright (c) 1995 - 2002 by Steffen Beyer.                            ##
  5. ##    All rights reserved.                                                   ##
  6. ##                                                                           ##
  7. ##    This package is free software; you can redistribute it                 ##
  8. ##    and/or modify it under the same terms as Perl itself.                  ##
  9. ##                                                                           ##
  10. ###############################################################################
  11.  
  12. package Date::Calc;
  13.  
  14. use strict;
  15. use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  16.  
  17. require Exporter;
  18. require DynaLoader;
  19.  
  20. @ISA = qw(Exporter DynaLoader);
  21.  
  22. @EXPORT = qw();
  23.  
  24. @EXPORT_OK = qw(
  25.     Days_in_Year
  26.     Days_in_Month
  27.     Weeks_in_Year
  28.     leap_year
  29.     check_date
  30.     check_time
  31.     check_business_date
  32.     Day_of_Year
  33.     Date_to_Days
  34.     Day_of_Week
  35.     Week_Number
  36.     Week_of_Year
  37.     Monday_of_Week
  38.     Nth_Weekday_of_Month_Year
  39.     Standard_to_Business
  40.     Business_to_Standard
  41.     Delta_Days
  42.     Delta_DHMS
  43.     Delta_YMD
  44.     Delta_YMDHMS
  45.     Normalize_DHMS
  46.     Add_Delta_Days
  47.     Add_Delta_DHMS
  48.     Add_Delta_YM
  49.     Add_Delta_YMD
  50.     Add_Delta_YMDHMS
  51.     System_Clock
  52.     Today
  53.     Now
  54.     Today_and_Now
  55.     This_Year
  56.     Gmtime
  57.     Localtime
  58.     Mktime
  59.     Timezone
  60.     Date_to_Time
  61.     Time_to_Date
  62.     Easter_Sunday
  63.     Decode_Month
  64.     Decode_Day_of_Week
  65.     Decode_Language
  66.     Decode_Date_EU
  67.     Decode_Date_US
  68.     Fixed_Window
  69.     Moving_Window
  70.     Compress
  71.     Uncompress
  72.     check_compressed
  73.     Compressed_to_Text
  74.     Date_to_Text
  75.     Date_to_Text_Long
  76.     English_Ordinal
  77.     Calendar
  78.     Month_to_Text
  79.     Day_of_Week_to_Text
  80.     Day_of_Week_Abbreviation
  81.     Language_to_Text
  82.     Language
  83.     Languages
  84.     Decode_Date_EU2
  85.     Decode_Date_US2
  86.     Parse_Date
  87.     ISO_LC
  88.     ISO_UC
  89. );
  90.  
  91. %EXPORT_TAGS = (all => [@EXPORT_OK]);
  92.  
  93. ##################################################
  94. ##                                              ##
  95. ##  "Version()" is available but not exported   ##
  96. ##  in order to avoid possible name clashes.    ##
  97. ##  Call with "Date::Calc::Version()" instead!  ##
  98. ##                                              ##
  99. ##################################################
  100.  
  101. $VERSION = '5.3';
  102.  
  103. bootstrap Date::Calc $VERSION;
  104.  
  105. sub Decode_Date_EU2
  106. {
  107.     die "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date);\n"
  108.       if (@_ != 1);
  109.  
  110.     my($buffer) = @_;
  111.     my($year,$month,$day,$length);
  112.  
  113.     if ($buffer =~ /^\D*  (\d+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D*$/x)
  114.     {
  115.         ($day,$month,$year) = ($1,$2,$3);
  116.         $month = Decode_Month($month);
  117.         unless ($month > 0)
  118.         {
  119.             return(); # can't decode month!
  120.         }
  121.     }
  122.     elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
  123.     {
  124.         $buffer = $1;
  125.         $length = length($buffer);
  126.         if    ($length == 3)
  127.         {
  128.             $day   = substr($buffer,0,1);
  129.             $month = substr($buffer,1,1);
  130.             $year  = substr($buffer,2,1);
  131.         }
  132.         elsif ($length == 4)
  133.         {
  134.             $day   = substr($buffer,0,1);
  135.             $month = substr($buffer,1,1);
  136.             $year  = substr($buffer,2,2);
  137.         }
  138.         elsif ($length == 5)
  139.         {
  140.             $day   = substr($buffer,0,1);
  141.             $month = substr($buffer,1,2);
  142.             $year  = substr($buffer,3,2);
  143.         }
  144.         elsif ($length == 6)
  145.         {
  146.             $day   = substr($buffer,0,2);
  147.             $month = substr($buffer,2,2);
  148.             $year  = substr($buffer,4,2);
  149.         }
  150.         elsif ($length == 7)
  151.         {
  152.             $day   = substr($buffer,0,1);
  153.             $month = substr($buffer,1,2);
  154.             $year  = substr($buffer,3,4);
  155.         }
  156.         elsif ($length == 8)
  157.         {
  158.             $day   = substr($buffer,0,2);
  159.             $month = substr($buffer,2,2);
  160.             $year  = substr($buffer,4,4);
  161.         }
  162.         else { return(); } # wrong number of digits!
  163.     }
  164.     elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
  165.     {
  166.         ($day,$month,$year) = ($1,$2,$3);
  167.     }
  168.     else { return(); } # no match at all!
  169.     $year = Moving_Window($year);
  170.     if (check_date($year,$month,$day))
  171.     {
  172.         return($year,$month,$day);
  173.     }
  174.     else { return(); } # not a valid date!
  175. }
  176.  
  177. sub Decode_Date_US2
  178. {
  179.     die "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date);\n"
  180.       if (@_ != 1);
  181.  
  182.     my($buffer) = @_;
  183.     my($year,$month,$day,$length);
  184.  
  185.     if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  0*(\d+)  \D*$/x)
  186.     {
  187.         ($month,$buffer) = ($1,$2);
  188.         $month = Decode_Month($month);
  189.         unless ($month > 0)
  190.         {
  191.             return(); # can't decode month!
  192.         }
  193.         $length = length($buffer);
  194.         if    ($length == 2)
  195.         {
  196.             $day  = substr($buffer,0,1);
  197.             $year = substr($buffer,1,1);
  198.         }
  199.         elsif ($length == 3)
  200.         {
  201.             $day  = substr($buffer,0,1);
  202.             $year = substr($buffer,1,2);
  203.         }
  204.         elsif ($length == 4)
  205.         {
  206.             $day  = substr($buffer,0,2);
  207.             $year = substr($buffer,2,2);
  208.         }
  209.         elsif ($length == 5)
  210.         {
  211.             $day  = substr($buffer,0,1);
  212.             $year = substr($buffer,1,4);
  213.         }
  214.         elsif ($length == 6)
  215.         {
  216.             $day  = substr($buffer,0,2);
  217.             $year = substr($buffer,2,4);
  218.         }
  219.         else { return(); } # wrong number of digits!
  220.     }
  221.     elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D+  (\d+)  \D*$/x)
  222.     {
  223.         ($month,$day,$year) = ($1,$2,$3);
  224.         $month = Decode_Month($month);
  225.         unless ($month > 0)
  226.         {
  227.             return(); # can't decode month!
  228.         }
  229.     }
  230.     elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
  231.     {
  232.         $buffer = $1;
  233.         $length = length($buffer);
  234.         if    ($length == 3)
  235.         {
  236.             $month = substr($buffer,0,1);
  237.             $day   = substr($buffer,1,1);
  238.             $year  = substr($buffer,2,1);
  239.         }
  240.         elsif ($length == 4)
  241.         {
  242.             $month = substr($buffer,0,1);
  243.             $day   = substr($buffer,1,1);
  244.             $year  = substr($buffer,2,2);
  245.         }
  246.         elsif ($length == 5)
  247.         {
  248.             $month = substr($buffer,0,1);
  249.             $day   = substr($buffer,1,2);
  250.             $year  = substr($buffer,3,2);
  251.         }
  252.         elsif ($length == 6)
  253.         {
  254.             $month = substr($buffer,0,2);
  255.             $day   = substr($buffer,2,2);
  256.             $year  = substr($buffer,4,2);
  257.         }
  258.         elsif ($length == 7)
  259.         {
  260.             $month = substr($buffer,0,1);
  261.             $day   = substr($buffer,1,2);
  262.             $year  = substr($buffer,3,4);
  263.         }
  264.         elsif ($length == 8)
  265.         {
  266.             $month = substr($buffer,0,2);
  267.             $day   = substr($buffer,2,2);
  268.             $year  = substr($buffer,4,4);
  269.         }
  270.         else { return(); } # wrong number of digits!
  271.     }
  272.     elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
  273.     {
  274.         ($month,$day,$year) = ($1,$2,$3);
  275.     }
  276.     else { return(); } # no match at all!
  277.     $year = Moving_Window($year);
  278.     if (check_date($year,$month,$day))
  279.     {
  280.         return($year,$month,$day);
  281.     }
  282.     else { return(); } # not a valid date!
  283. }
  284.  
  285. sub Parse_Date
  286. {
  287.     die "Usage: (\$year,\$month,\$day) = Parse_Date(\$date);\n"
  288.       if (@_ != 1);
  289.  
  290.     my($date) = @_;
  291.     my($year,$month,$day);
  292.     unless ($date =~ /\b([JFMASOND][aepuco][nbrynlgptvc])\s+([0123]??\d)\b/)
  293.     {
  294.         return();
  295.     }
  296.     $month = $1;
  297.     $day   = $2;
  298.     unless ($date =~ /\b(19\d\d|20\d\d)\b/)
  299.     {
  300.         return();
  301.     }
  302.     $year  = $1;
  303.     $month = Decode_Month($month);
  304.     unless ($month > 0)
  305.     {
  306.         return();
  307.     }
  308.     unless (check_date($year,$month,$day))
  309.     {
  310.         return();
  311.     }
  312.     return($year,$month,$day);
  313. }
  314.  
  315. 1;
  316.  
  317. __END__
  318.  
  319.