home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / DateTimePP.pm < prev    next >
Encoding:
Perl POD Document  |  2010-07-30  |  5.2 KB  |  215 lines

  1. package DateTime;
  2. BEGIN {
  3.   $DateTime::VERSION = '0.61';
  4. }
  5.  
  6. use strict;
  7. use warnings;
  8.  
  9. $DateTime::IsPurePerl = 1;
  10.  
  11. my @MonthLengths = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  12.  
  13. my @LeapYearMonthLengths = @MonthLengths;
  14. $LeapYearMonthLengths[1]++;
  15.  
  16. my @EndOfLastMonthDayOfYear;
  17. {
  18.     my $x = 0;
  19.     foreach my $length (@MonthLengths) {
  20.         push @EndOfLastMonthDayOfYear, $x;
  21.         $x += $length;
  22.     }
  23. }
  24.  
  25. my @EndOfLastMonthDayOfLeapYear = @EndOfLastMonthDayOfYear;
  26. $EndOfLastMonthDayOfLeapYear[$_]++ for 2 .. 11;
  27.  
  28. sub _time_as_seconds {
  29.     shift;
  30.     my ( $hour, $min, $sec ) = @_;
  31.  
  32.     $hour ||= 0;
  33.     $min  ||= 0;
  34.     $sec  ||= 0;
  35.  
  36.     my $secs = $hour * 3600 + $min * 60 + $sec;
  37.     return $secs;
  38. }
  39.  
  40. sub _rd2ymd {
  41.     my $class = shift;
  42.  
  43.     use integer;
  44.     my $d  = shift;
  45.     my $rd = $d;
  46.  
  47.     my $yadj = 0;
  48.     my ( $c, $y, $m );
  49.  
  50.     # add 306 days to make relative to Mar 1, 0; also adjust $d to be
  51.     # within a range (1..2**28-1) where our calculations will work
  52.     # with 32bit ints
  53.     if ( $d > 2**28 - 307 ) {
  54.  
  55.         # avoid overflow if $d close to maxint
  56.         $yadj = ( $d - 146097 + 306 ) / 146097 + 1;
  57.         $d -= $yadj * 146097 - 306;
  58.     }
  59.     elsif ( ( $d += 306 ) <= 0 ) {
  60.         $yadj = -( -$d / 146097 + 1 )
  61.             ;    # avoid ambiguity in C division of negatives
  62.         $d -= $yadj * 146097;
  63.     }
  64.  
  65.     $c = ( $d * 4 - 1 )
  66.         / 146097;    # calc # of centuries $d is after 29 Feb of yr 0
  67.     $d -= $c * 146097 / 4;    # (4 centuries = 146097 days)
  68.     $y = ( $d * 4 - 1 ) / 1461;    # calc number of years into the century,
  69.     $d -= $y * 1461 / 4;           # again March-based (4 yrs =~ 146[01] days)
  70.     $m = ( $d * 12 + 1093 )
  71.         / 367;    # get the month (3..14 represent March through
  72.     $d -= ( $m * 367 - 1094 ) / 12;    # February of following year)
  73.     $y += $c * 100 + $yadj * 400;      # get the real year, which is off by
  74.     ++$y, $m -= 12 if $m > 12;         # one if month is January or February
  75.  
  76.     if ( $_[0] ) {
  77.         my $dow;
  78.  
  79.         if ( $rd < -6 ) {
  80.             $dow = ( $rd + 6 ) % 7;
  81.             $dow += $dow ? 8 : 1;
  82.         }
  83.         else {
  84.             $dow = ( ( $rd + 6 ) % 7 ) + 1;
  85.         }
  86.  
  87.         my $doy = $class->_end_of_last_month_day_of_year( $y, $m );
  88.  
  89.         $doy += $d;
  90.  
  91.         my $quarter;
  92.         {
  93.             no integer;
  94.             $quarter = int( ( 1 / 3.1 ) * $m ) + 1;
  95.         }
  96.  
  97.         my $qm = ( 3 * $quarter ) - 2;
  98.  
  99.         my $doq
  100.             = ( $doy - $class->_end_of_last_month_day_of_year( $y, $qm ) );
  101.  
  102.         return ( $y, $m, $d, $dow, $doy, $quarter, $doq );
  103.     }
  104.  
  105.     return ( $y, $m, $d );
  106. }
  107.  
  108. sub _ymd2rd {
  109.     shift;    # ignore class
  110.  
  111.     use integer;
  112.     my ( $y, $m, $d ) = @_;
  113.     my $adj;
  114.  
  115.     # make month in range 3..14 (treat Jan & Feb as months 13..14 of
  116.     # prev year)
  117.     if ( $m <= 2 ) {
  118.         $y -= ( $adj = ( 14 - $m ) / 12 );
  119.         $m += 12 * $adj;
  120.     }
  121.     elsif ( $m > 14 ) {
  122.         $y += ( $adj = ( $m - 3 ) / 12 );
  123.         $m -= 12 * $adj;
  124.     }
  125.  
  126.     # make year positive (oh, for a use integer 'sane_div'!)
  127.     if ( $y < 0 ) {
  128.         $d -= 146097 * ( $adj = ( 399 - $y ) / 400 );
  129.         $y += 400 * $adj;
  130.     }
  131.  
  132.     # add: day of month, days of previous 0-11 month period that began
  133.     # w/March, days of previous 0-399 year period that began w/March
  134.     # of a 400-multiple year), days of any 400-year periods before
  135.     # that, and finally subtract 306 days to adjust from Mar 1, year
  136.     # 0-relative to Jan 1, year 1-relative (whew)
  137.  
  138.     $d
  139.         += ( $m * 367 - 1094 ) / 12
  140.         + $y % 100 * 1461 / 4
  141.         + ( $y / 100 * 36524 + $y / 400 ) - 306;
  142. }
  143.  
  144. sub _seconds_as_components {
  145.     shift;
  146.     my $secs     = shift;
  147.     my $utc_secs = shift;
  148.     my $modifier = shift || 0;
  149.  
  150.     use integer;
  151.  
  152.     $secs -= $modifier;
  153.  
  154.     my $hour = $secs / 3600;
  155.     $secs -= $hour * 3600;
  156.  
  157.     my $minute = $secs / 60;
  158.  
  159.     my $second = $secs - ( $minute * 60 );
  160.  
  161.     if ( $utc_secs && $utc_secs >= 86400 ) {
  162.  
  163.         # there is no such thing as +3 or more leap seconds!
  164.         die "Invalid UTC RD seconds value: $utc_secs"
  165.             if $utc_secs > 86401;
  166.  
  167.         $second += $utc_secs - 86400 + 60;
  168.  
  169.         $minute = 59;
  170.  
  171.         $hour--;
  172.         $hour = 23 if $hour < 0;
  173.     }
  174.  
  175.     return ( $hour, $minute, $second );
  176. }
  177.  
  178. sub _end_of_last_month_day_of_year {
  179.     my $class = shift;
  180.  
  181.     my ( $y, $m ) = @_;
  182.     $m--;
  183.     return (
  184.           $class->_is_leap_year($y)
  185.         ? $EndOfLastMonthDayOfLeapYear[$m]
  186.         : $EndOfLastMonthDayOfYear[$m]
  187.     );
  188. }
  189.  
  190. sub _is_leap_year {
  191.     shift;
  192.     my $year = shift;
  193.  
  194.     # According to Bjorn Tackmann, this line prevents an infinite loop
  195.     # when running the tests under Qemu. I cannot reproduce this on
  196.     # Ubuntu or with Strawberry Perl on Win2K.
  197.     return 0 if $year == INFINITY() || $year == NEG_INFINITY();
  198.     return 0 if $year % 4;
  199.     return 1 if $year % 100;
  200.     return 0 if $year % 400;
  201.  
  202.     return 1;
  203. }
  204.  
  205. sub _day_length { DateTime::LeapSecond::day_length( $_[1] ) }
  206.  
  207. sub _accumulated_leap_seconds { DateTime::LeapSecond::leap_seconds( $_[1] ) }
  208.  
  209. # This is down here so that _ymd2rd is available when it loads,
  210. # because it will load DateTime::LeapSecond, which needs
  211. # DateTime->_ymd2rd to be available when it is loading
  212. use DateTimePPExtra;
  213.  
  214. 1;
  215.