view release on metacpan or  search on metacpan

lib/JE/Object/Date.pm  view on Meta::CPAN

	
	($tmp, $time) = _div $time, MS_PER_DAY * 365;
	# Same special case we encountered when dividing qcms, since there
	# is an extra day on the end.
	if($tmp == 4) {
		return $prec + 4 + 2000;
	}
	$prec + 2000 + $tmp +    # Add 1 if we are past Dec.:
		($time >= (31+30+31+30+31+31+30+31+30+31) * MS_PER_DAY);
		           # days from Mar 1 to Jan 1
}
sub _in_leap_year($) { _days_in_year &_year_from_time == 366 }
sub _day_within_year($) { &_day - _day_from_year &_year_from_time }
sub _month_from_time($) {
	my $dwy = &_day_within_year;
	my $ily = &_in_leap_year;
	return 0 if $dwy < 31;
	my $counter = 1;
	for (qw/59 90 120 151 181 212 243 273 304 334 365/) {
		return $counter if $dwy < $_ + $ily;
		++$counter;
	}
}
sub _date_from_time($) {
	my $dwy = &_day_within_year;
	my $mft = &_month_from_time;
	return $dwy+1 unless $mft;
	return $dwy-30 if $mft == 1;
	return $dwy - qw/0 0 58 89 119 150 180 211 242 272 303 333/[$mft]
		- &_in_leap_year;
}
sub _week_day($) { (&_day + 4) % 7 }

# $_dumdeedum[0] will contain the nearest non-leap-year that begins on Sun-
# day, $_dumdeedum[1] the nearest beginning on Monday, etc.
# @_dumdeedum[7..15] are for leap years.
# For the life of me I can't think of a name for this array!
{
	my @_dumdeedum; 

	my $this_year = (gmtime(my $time = time))[5]+1900;
	$_dumdeedum[_week_day(_time_from_year _year_from_time $time*1000) +
		7 * (_days_in_year($this_year)==366) ] = $this_year;

	my $next_past = my $next_future = $this_year;
	my $count = 1; my $index;
	while ($count < 14) {
		$index = (_day_from_year(--$next_past) + 4) % 7 +
			7 * (_days_in_year($next_past)==366);
		unless (defined $_dumdeedum[$index]) {
			$_dumdeedum[$index] = $next_past;
			++$count;
		}
		$index = (_day_from_year(++$next_future) + 4) % 7 +
			7 * (_days_in_year($next_future)==366);
		unless (defined $_dumdeedum[$index]) {
			$_dumdeedum[$index] = $next_future;
			++$count;
		}
	}
# The spec requires that the same formula for daylight savings be used for
# all years.  An ECMAScript implementation is not  allowed  to  take  into
# account that the formula might have changed in the past. That's what the
# @_dumdeedum array is for. The spec basically allows for fourteen differ-
# ent possibilities for the dates for daylight savings time  change.  The
# code above collects the 'nearest' fourteen years that are not equivalent
# to each other.

	sub _ds_time_adjust($) {
		my $year = _year_from_time(my $time = $_[0]);
		my $ddd_index = (_day_from_year($year) + 4) % 7 +
				7 * (_days_in_year $year == 366);
		my $time_within_year = $time - _time_from_year $year;
		(localtime
		  +(
		    $time_within_year +
		    _time_from_year $_dumdeedum[$ddd_index]
		  ) / 1000 # convert to seconds
		  + EPOCH_OFFSET
		)[8] * 3600_000
	}
}

sub _gm2local($) {
	# shortcut for nan & inf to avoid localtime(nan) warning
	return $_[0] unless $_[0] == $_[0] and $_[0]+1 != $_[0];

	$_[0] + LOCAL_TZA + &_ds_time_adjust
}

sub _local2gm($) {
	# shortcut for nan & inf to avoid localtime(nan) warning
	return $_[0] unless $_[0] == $_[0] and $_[0]+1 != $_[0];

	$_[0] - LOCAL_TZA - _ds_time_adjust $_[0] - LOCAL_TZA
}

sub _hours_from_time($) { floor($_[0] / 3600_000) % 24 }
sub _min_from_time($) { floor($_[0] / 60_000) % 60 }
sub _sec_from_time($) { floor($_[0] / 1000) % 60 }
sub _ms_from_time($) { $_[0] % 1000 }

sub _make_time($$$$) {
	my ($hour, $min, $sec, $ms) = @_;
	for(\($hour, $min, $sec, $ms)) {
		$$_ + 1 == $$_ or $$_ != $$_ and return sin 9**9**9;
		$$_ = int $$_; # ~~~ Is this necessary? Is it sufficient?
	}
	$hour * 3600_000 +
	$min  *   60_000 +
	$sec  *     1000 +
	$ms;
}

sub _make_day($$$) {
	my ($year, $month, $date) = @_;
	for(\($year, $month, $date)) {
		$$_ + 1 == $$_ or $$_ != $$_ and return sin 9**9**9;
		$$_ = int $$_; # ~~~ Is it sufficient?
	}
	$year += floor($month/12);
	$month %= 12;
	_timegm(0,0,0,$date,$month,$year)