local-lib5/lib/perl5/i486-linux-gnu-thread-multi/DateTimePP.pm

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