Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Date / Simple / NoXS.pm

# Date::Simple::NoXS - used internally by Date::Simple.

use strict;

package Date::Simple;

sub ymd {
   my $days = &ymd_to_days;
   return undef unless defined ($days);
   return (bless (\$days, __PACKAGE__));
}

sub d8 {
   my ($d8) = @_;
   my @ymd = $d8 =~ m/^(\d{4})(\d\d)(\d\d)$/ or return undef;
   return ymd (@ymd);
}

# Precise integer arithmetic functions unfortunately missing from
# Perl's core:

sub _divmod {
   my ($quot, $int);

   $quot = $_[0] / $_[1];
   $int = int($quot);
   $int -= 1 if $int > $quot;
   $_[0] %= $_[1];
   return $int;
};

sub _div {
   my ($quot, $int);

   $quot = $_[0] / $_[1];
   $int = int($quot);
   return $int - 1 if $int > $quot;
   return $int;
};

sub leap_year {
   my $y = shift;
   return (($y%4==0) and ($y%400==0 or $y%100!=0)) || 0;
}

my @days_in_month = (
[0,31,28,31,30,31,30,31,31,30,31,30,31],
[0,31,29,31,30,31,30,31,31,30,31,30,31],
);

sub days_in_month ($$) {
   my ($y,$m) = @_;
   return $days_in_month[leap_year($y)][$m];
}

sub validate ($$$) {
   my ($y, $m, $d)= @_;
   # any +ve integral year is valid
   return 0 if $y != abs int $y;
   return 0 unless 1 <= $m and $m <= 12;
   return 0 unless 1 <= $d and $d <= $days_in_month[leap_year($y)][$m];
   return 1;
}

# Given a year, month, and day, return the canonical day number.
# That is the number of days since 1 January 1970, negative if earlier.
sub ymd_to_days {
   my ($Y, $M, $D) = @_;
   my ($days, $x);

   if ($M < 1 || $M > 12 || $D < 1 ||
       ($D > 28 && $D > days_in_month($Y, $M)))
   {
       return undef;
   }

   $days = $D +
       (undef, -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333)[$M];
   $days += 365 * ($Y - 1970);
   $x = ($M <= 2 ? $Y-1 : $Y);
   $days += _div (($x - 1968), 4);
   $days -= _div (($x - 1900), 100);
   $days += _div (($x - 1600), 400);
   return $days;
}

sub days_since_1970 { ${$_[0]} }

# Given a canonical day number (days since 1 Jan 1970), return the
# year, month, and day.
sub days_to_ymd {
   my ($days) = @_;
   my ($year, $mnum, $mday, $tmp);

   # Shift frame of reference from 1 Jan 1970 to (the imaginary) 1 Mar 0AD.
   $tmp = $days + 719468;

   # Do the math.
   $year = 400 * _divmod ($tmp, 146097);
   if ($tmp == 146096) {
       # Handle 29 Feb 2000, 2400, ...
       $year += 400;
       $mnum = 2;
       $mday = 29;
   } else {
       $year += 100 * _divmod ($tmp, 36524);
       $year += 4 * _divmod ($tmp, 1461);
       if ($tmp == 1460) {
           $year += 4;
           $mnum = 2;
           $mday = 29;
       } else {
           $year += _divmod ($tmp, 365);
           $mnum = _divmod ($tmp, 31);
           $mday = $tmp + (1, 1, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5)[$mnum];
           $tmp = (31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 28)[$mnum];
           if ($mday > $tmp) {
               $mday -= $tmp;
               $mnum += 1;
           }
           if ($mnum > 9) {
               $mnum -= 9;
               $year += 1;
           } else {
               $mnum += 3;
           }
       }
   }
   return ($year, $mnum, $mday);
}

sub as_ymd { return days_to_ymd (${$_[0]}); }
sub as_d8  { return sprintf ("%04d%02d%02d", &as_ymd); }

sub year  { return (&as_ymd) [0]; }
sub month { return (&as_ymd) [1]; }
sub day   { return (&as_ymd) [2]; }

sub day_of_week {
   return ((${$_[0]} + 4) % 7);
}

#------------------------------------------------------------------------------
# the following methods are called by the overloaded operators, so they should
# not normally be called directly.
#------------------------------------------------------------------------------
sub _stringify { return sprintf ("%04d-%02d-%02d", &as_ymd); }

sub _add {
   my ($date, $diff) = @_;

   if ($diff !~ /^-?\d+$/) {
       Carp::croak ("Date interval must be an integer");
   }
   return (bless (\ ($$date + $diff), ref($date)));
}

sub _subtract {
   my ($left, $right, $reverse) = @_;

   if ($reverse) {
       Carp::croak ("Can't subtract a date from a non-date");
   }
   if (ref($right) eq '' && $right =~ /^-?\d+$/) {
       return (bless (\ ($$left - $right), ref($left)));
   }
   return ($$left - $$right);
}

sub _compare {
   my ($left, $right, $reverse) = @_;

   $right = $left->new($right) || _inval ($left, $right);
   return ($reverse ? $$right <=> $$left : $$left <=> $$right);
}

sub _eq {
   my ($left, $right) = @_;
   return (($right = $left->_new($right)) && $$right == $$left);
}

sub _ne {
   return (!&_eq);
}

1;

=head1 NAME

Date::Simple::NoXS - Pure Perl support for Date::Simple.

=head1 SYNOPSIS

   use Date::Simple;

=head1 DESCRIPTION

Used internally by Date::Simple.

=head1 SEE ALSO

L<Date::Simple>.

=cut