JE::Object::Date - JavaScript Date object class

  use JE;

  $j = new JE;

  $js_date = new JE::Object::Date $j;

  $js_date->value; # 1174886940.466
  "$js_date";      # Sun Mar 25 22:29:00 2007 -0700

package JE::Object::Date;

our $VERSION = '0.042';


use strict;
use warnings; no warnings 'utf8';

use JE::Code 'add_line_number';
#use Memoize;
use POSIX 'floor';
use Scalar::Util 1.1 qw'blessed weaken looks_like_number';
use Time::Local 'timegm_nocheck';
use Time::Zone 'tz_local_offset';

our @ISA = 'JE::Object';

##require JE::Number;
require JE::Object;
require JE::Object::Error::TypeError;
require JE::Object::Function;
require JE::String;

use constant EPOCH_OFFSET => timegm_nocheck(0,0,0,1,0,1970);

my %mon_numbers = qw/ Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5 Jul 6 Aug 7 Sep 8
                      Oct 9 Nov 10 Dec 11 /;

sub new {
	my($class, $global) = (shift, shift);
	my $self = $class->SUPER::new($global, {
		prototype => $global->prototype_for('Date')
		          || $global->prop('Date')->prop('prototype')
	});

	if (@_ >= 2) {
		my($year,$month,$date,$hours,$minutes,$seconds,$ms) = @_;
		for($year,$month) {
			defined()
			? defined blessed $_ && $_->can('to_number') &&
			  ($_ = $_->to_number->value)
			: ($_ = sin 9**9**9);
		}
		defined $date
		? defined blessed $date && $date->can('to_number') &&
		  ($date = $date->to_number->value)
		: ($date = 1);
		for($hours,$minutes,$seconds,$ms) {
			no warnings 'uninitialized'; # undef --> 0
			$_ = defined blessed $_ && (can $_ 'to_number')
			?	$_->to_number->value
			:	0+$_;
		}
		$year >= 0 and int($year) <= 99 and $year += 1900;
		$$$self{value} = _time_clip(_local2gm(_make_date(
			_make_day($year,$month,$date),
			_make_time($hours,$minutes,$seconds,$ms),
		)));
		
	}
	elsif (@_ and
            defined blessed $_[0]
	    ? (my $prim = $_[0]->to_primitive)->isa('JE::String')
	    : !looks_like_number $_[0]) {
		$$$self{value} = _parse_date("$_[0]");
			
	} elsif(@_) {
		$$$self{value} = _time_clip (
			defined $_[0]
			? defined blessed $_[0]
			  && $_[0]->can('to_number')
				? $_[0]->to_number->value
				: 0+$_[0]
			: 0
		);
	} else {
		$$$self{value} = (time - EPOCH_OFFSET) * 1000;
	}
	$self;
}

sub value { $${$_[0]}{value}/1000 + EPOCH_OFFSET }

sub class { 'Date' }



sub to_primitive { SUPER::to_primitive{shift}@_?@_:'string' }

# Most of these functions were copied directly from ECMA-262. Those were
# not optimised for speed,  but apparently either for clarity or obfusca-
# tion--I’ve yet to ascertain which. These need to be optimized, and many
# completely rewritten.

# ~~~ Are these useful enough to export them?
sub MS_PER_DAY() { 86400000 }
use constant LOCAL_TZA => do {
 # ~~~ I need to test this by subtracting 6 mumps -- but how?
	my $time = time;
	1000 * (tz_local_offset($time) - (localtime $time)[8] * 3600)
};

# ~~~ I still need to figure which of these (if any) actually benefit from
#     memoisation.

# This stuff was is based on code from Time::Local 1.11, with various
# changes (particularly the removal of stuff we don’t need).
my @MonthDays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
my %Cheat;
sub _daygm {
    $_[3] + ($Cheat{pack("ll",@_[4,5])} ||= do {
        my $month = ($_[4] + 10) % 12;
        my $year = $_[5] - int $month/10;
        365*$year + int($year/4) - int($year/100) + int($year/400) +
            int(($month*306 + 5)/10) - 719469
    });
}
sub _timegm {
	my ($sec,$min,$hour,$mday,$month,$year) = @_;

	my $days = _daygm(undef, undef, undef, $mday, $month, $year);
	my $xsec = $sec + 60*$min + 3600*$hour;

	$xsec + 86400 * $days;	
}


sub _day($) { floor $_[0] / MS_PER_DAY }
sub _time_within_day($) { $_[0] % MS_PER_DAY }
sub _days_in_year($) {
	365 + not $_[0] % 4 || !($_[0] % 100) && $_[0] % 400
}
sub _day_from_year($) {
	my $y = shift;
	365 * ($y - 1970) + floor(($y - 1969) / 4) -
		floor(($y - 1901) / 100) + floor(($y - 1601) / 400)
}
sub _time_from_year($) { MS_PER_DAY * &_day_from_year }
sub _div($$) {
    my $mod = $_[0] % $_[1];
    return +($_[0] - $mod) / $_[1], $mod;
}
sub _year_from_time($) {
	# This line adjusts the  time  so  that  1/Mar/2000  is  0,  and
	# 29/Feb/2400, the extra leap day in the quadricentennium, is the
	# last day therein.  (So a qcm is  4 centuries  +  1  leap  day.)
	my $time = $_[0] - 951868800_000;

	(my $prec, $time) = _div $time, MS_PER_DAY * (400 * 365 + 97);
	$prec *= 400; # number of years preceding the current quadri-
	                  # centennium

	# Divide by a century and we have centuries preceding the current
	# century and the time within the century, unless $tmp == 4, ...
	(my $tmp, $time) = _div $time, MS_PER_DAY * (100 * 365 + 24);
	if($tmp == 4) { # ... in which case we already know the year, since
	                # this is the last day of a qcm
		return $prec + 400 + 2000;
	}
	$prec += $tmp * 100; # preceding the current century
	
	# A century is 24 quadrennia followed by four non-leap years, or,
	# since we are starting with March,  25 quadrennia with one day 
	# knocked off the end.  So no special casing is  needed  here.
	($tmp, $time) = _div $time, MS_PER_DAY * (4 * 365 + 1);
	$prec += $tmp * 4; # preceding the current quadrennium
	
	($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?
	}
	$month <0 || $month > 11 and return sin 9**9**9; # ~~~ I sthis necessary?
	_timegm(0,0,0,$date,$month,$year)
		/
	(MS_PER_DAY/1000)
}

sub _make_date($$) {
	my ($day, $time) = @_;
	for(\($day, $time)) {
		$$_ + 1 == $$_ or $$_ != $$_ and return sin 9**9**9;
	}
	$day * MS_PER_DAY + $time
}

sub _time_clip($) {
	my ($time) = @_;
	$time + 1 == $time or $time != $time and return sin 9**9**9;
	abs($time) > 8.64e15 and return sin 9**9**9;
	int $time
}

sub _parse_date($) {
	# If the date matches the format output by
	# to(GMT|UTC|Locale)?String, we need to parse it ourselves.
	# Otherwise, we pass it on to Date::Parse, and live with
	# the latter’s limited range.
	# ~~~ (Maybe I should change this to use
	#      DateTime::Format::Natural.)

	my $str = shift;
	my $time;
	if($str =~ /^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
                        (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]
                        ([ \d]\d)\ (\d\d):(\d\d):(\d\d)\ (\d{4,})
                        [ ]([+-]\d{2})(\d{2})
                    \z/x) {
		$time = _timegm($5,$4,$3,$2,$mon_numbers{$1},$6)
			+ $7*-3600 + $8*60;
	} elsif($str =~ /^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat),[ ]
                        (\d\d?)[ ]
                        (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]
	    	    (\d{4,})\ (\d\d):(\d\d):(\d\d)\ GMT 
                    \z/x) {
		$time = _timegm($6,$5,$4,$1,$mon_numbers{$2},$3);
	} else {
		require Date::Parse;
		if(defined($time = Date::Parse::str2time($str))) {
			$time -= EPOCH_OFFSET
		}
	}
	defined $time ? $time * 1000 :
		sin 9**9**9;
}

my @days = qw/ Sun Mon Tue Wed Thu Fri Sat Sun /;
my @mon  = qw/ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /;
sub _new_constructor {
	() = (@days, @mon); # work-around for perl bug #16302
	my $global = shift;
	my $f = JE::Object::Function->new({
		name            => 'Date',
		scope            => $global,
		argnames         => [qw/year    month date hours minutes
		                        seconds ms/],
		function         => sub {
			my $time = time;
			my $offset = tz_local_offset($time);
			my $sign = qw/- +/[$offset >= 0];
			return JE::String->_new($global,
				localtime($time) . " $sign" .
				sprintf '%02d%02d',
					_div abs($offset)/60, 60
			);
		},
		function_args    => [],
		constructor      => sub {
			unshift @_, __PACKAGE__;
			goto &new;
		},
		constructor_args => ['scope','args'],
	});

	$f->prop({
		name  => 'parse',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'parse',
			argnames => ['string'],
			no_proto => 1,
			function_args => ['args'],
			function => sub {
				my $str = shift;
				JE::Number->new($global, 
				    defined $str
				    ? _parse_date $str->to_string->value
				    : 'nan'
				);
			},
		}),
		dontenum => 1,
	});

	$f->prop({
	  name  => 'UTC',
	  value => JE::Object::Function->new({
	    scope  => $global,
	    name    => 'UTC',
	    argnames => [qw 'year month date hours minutes
	                     seconds ms' ],
	    no_proto => 1,
	    function_args => ['args'],
	    function => sub {
	      my($year,$month,$date,$hours,$minutes,$seconds,$ms) = @_;
	      for($year,$month) {
	        $_ = defined() ? $_->to_number->value : sin 9**9**9
	      }
	      $date = defined $date ? $date->to_number->value : 1;
	      for($hours,$minutes,$seconds,$ms) {
	        $_ = defined $_ ? $_->to_number->value : 0;
	      }
	      $year >= 0 and int($year) <= 99 and $year += 1900;
	      JE::Number->new($global, 
	        _time_clip(_make_date(
	          _make_day($year,$month,$date),
	          _make_time($hours,$minutes,$seconds,$ms),
	        ))
	      );
	    },
	  }),
	  dontenum => 1,
	});

	my $proto = bless $f->prop({
		name    => 'prototype',
		dontenum => 1,
		readonly => 1,
	}), __PACKAGE__;
	$global->prototype_for('Date'=>$proto);

	$$$proto{value} = sin 9**9**9;

	$proto->prop({
		name  => 'toString',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'toString',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to toString ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
			  # Can’t use localtime because of its lim-
			  # ited range.
			  my $v = $${+shift}{value};
			  my $time = _gm2local $v;
			  my $offset = ($time - $v) / 60_000;
			  my $sign = qw/- +/[$offset >= 0];
			  return JE::String->_new($global,
			    sprintf
			      '%s %s %2d %02d:%02d:%02d %04d %s%02d%02d',
			      $days[_week_day $time],       # Mon
			      $mon[_month_from_time $time], # Dec
			      _date_from_time $time,        # 31
			      _hours_from_time $time,       # 11:42:40
			      _min_from_time $time,         
			      _sec_from_time $time,
			      _year_from_time $time,        # 2007
			      $sign,                        # -
			      _div abs($offset), 60         # 0800
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'toDateString',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'toString',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to toDateString ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
			  my $time = _gm2local $${+shift}{value};
			  return JE::String->_new($global,
			    sprintf
			      '%s %s %d %04d',
			      $days[_week_day $time],       # Mon
			      $mon[_month_from_time $time], # Dec
			      _date_from_time $time,        # 31
			      _year_from_time $time,        # 2007
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'toTimeString',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'toTimeString',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to toTimeString ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
			  my $time = _gm2local $${+shift}{value};
			  return JE::String->_new($global,
			    sprintf
			      '%02d:%02d:%02d',
			      _hours_from_time $time, 
			      _min_from_time $time,         
			      _sec_from_time $time,
			  );
			},
		}),
		dontenum => 1,
	});

	# ~~~ How exactly should I make these three behave? Should I leave
	#     them as they is?
	$proto->prop({
		name => 'toLocaleString',
		value => $proto->prop('toString'),
		dontenum => 1,
	});
	$proto->prop({
		name => 'toLocaleDateString',
		value => $proto->prop('toDateString'),
		dontenum => 1,
	});
	$proto->prop({
		name => 'toLocaleTimeString',
		value => $proto->prop('toTimeString'),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'valueOf',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'valueOf',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to valueOf ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
				JE::Number->new(
					$global,$${+shift}{value}
				);
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getTime',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getTime',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
				$_[0]->class eq 'Date' or die
					JE'Object'Error'TypeError->new(
						$global,
						"getTime cannot be called".
						" on an object of type " .
						shift->class
					);
				JE::Number->new(
					$global,$${+shift}{value}
				);
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getYear',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getYear',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to getYear ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _year_from_time(_gm2local $v) - 1900
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getFullYear',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getFullYear',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to getFullYear ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _year_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getUTCFullYear',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getUTCFullYear',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getUTCFullYear cannot be " .
			     "called on an object of type " . $_[0]->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _year_from_time( $v)
			  );
			},
		}),
		dontenum => 1,
	});


	$proto->prop({
		name  => 'getMonth',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getMonth',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			      "Arg to getMonth ($_[0]) is not a date")
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _month_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getUTCMonth',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getUTCMonth',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getUTCMonth cannot be called".
			      " on an object of type " . $_[0]->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _month_from_time($v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getDate',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getDate',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			    "getDate cannot be called on an object of type"
			    . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _date_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getUTCDate',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getUTCDate',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getUTCDate cannot be called ".
			    "on an object of type"
			    . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _date_from_time($v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getDay',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getDay',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			    "getDay cannot be called on an object of type"
			    . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _week_day(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getUTCDay',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getUTCDay',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getUTCDay cannot be called ".
			    "on an object of type"
			    . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _week_day($v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getHours',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getHours',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number
			   "getHours cannot be called on an object of type"
			    . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _hours_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getUTCHours',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getUTCHours',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getUTCHours cannot be called".
			    " on an object of type"
			    . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _hours_from_time($v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getMinutes',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getMinutes',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getMinutes cannot be called" .
			      " on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _min_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getUTCMinutes',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getUTCMinutes',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getUTCMinutes cannot be " .
			      "called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _min_from_time($v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getSeconds',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getSeconds',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getSeconds cannot be called" .
			      " on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _sec_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name => 'getUTCSeconds',
		value => $proto->prop('getSeconds'),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getMilliseconds',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getMilliseconds',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getMilliseconds cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    _ms_from_time(_gm2local $v)
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name => 'getUTCMilliseconds',
		value => $proto->prop('getMilliseconds'),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'getTimezoneOffset',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'getTimezoneOffset',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "getTimezoneOffset cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  $v == $v or return JE::Number->new($global,$v);
			  JE::Number->new( $global,
			    ($v - _gm2local $v) / 60_000
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'setTime',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setTime',
			argnames => ['time'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setTime cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip(
			      defined $_[1] ? $_[1]->to_number->value :
			        sin 9**9**9
			    )
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'setMilliseconds',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setMilliseconds',
			argnames => ['ms'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setMilliseconds cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${$_[0]}{value};
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _make_date
			      _day $v,
			      _make_time
			        _hours_from_time $v,
			        _min_from_time $v,
			        _sec_from_time $v,
			        defined $_[1] ? $_[1]->to_number->value :
			          sin 9**9**9
			  );
			},
		}),
		dontenum => 1,
	});

	$proto->prop({
		name => 'setUTCMilliseconds',
		value => $proto->prop('setMilliseconds'),
		dontenum => 1,
	});

	$proto->prop({
		name  => 'setSeconds',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setSeconds',
			argnames => ['sec','ms'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setSeconds cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $s = defined $_[1] ? $_[1]->to_number->value
			    : sin 9**9**9;
			  if($s != $s) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new($global,sin 9**9**9);
			  }
			  my $v = $${$_[0]}{value};
			  my $ms =
			   defined $_[2]
			   ? $_[2]->to_number->value
			   : _ms_from_time $v;
			  if($ms!=$ms) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new(sin 9**9**9);
			  }
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _make_date
			      _day $v,
			      _make_time
			        _hours_from_time $v,
			        _min_from_time $v,
			         $s,
			         $ms,
			  );
			},
		}),
		dontenum => 1,
	});

	# ~~~ setUTCSeconds

	$proto->prop({
		name  => 'setMinutes',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setMinutes',
			argnames => ['min','sec','ms'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setHours cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $m = defined $_[1] ? $_[1]->to_number->value
			    : sin 9**9**9;
			  if($m != $m) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new($global,sin 9**9**9);
			  }
			  my $v = _gm2local $${$_[0]}{value};
			  my $s =
			   defined $_[2]
			   ? $_[2]->to_number->value
			   : _sec_from_time $v;
			  my $ms =
			   defined $_[3]
			   ? $_[3]->to_number->value
			   : _ms_from_time $v;
			  if($s!=$s || $ms!=$ms) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new(sin 9**9**9);
			  }
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _local2gm _make_date
			      _day $v,
			      _make_time _hours_from_time $v, $m, $s, $ms
			  );
			},
		}),
		dontenum => 1,
	});

	# ~~~ setUTCMinutes

	$proto->prop({
		name  => 'setHours',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setHours',
			argnames => ['hour','min','sec','ms'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setHours cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $h = defined $_[1] ? $_[1]->to_number->value
			    : sin 9**9**9;
			  if($h != $h) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new($global,sin 9**9**9);
			  }
			  my $v = _gm2local $${$_[0]}{value};
			  my $m =
			   defined $_[2]
			   ? $_[2]->to_number->value
			   : _min_from_time $v;
			  my $s =
			   defined $_[3]
			   ? $_[3]->to_number->value
			   : _sec_from_time $v;
			  my $ms =
			   defined $_[4]
			   ? $_[4]->to_number->value
			   : _ms_from_time $v;
			  if($m!=$m || $s!=$s || $ms!=$ms) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new(sin 9**9**9);
			  }
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _local2gm _make_date
			      _day $v,
			      _make_time $h, $m, $s, $ms
			  );
			},
		}),
		dontenum => 1,
	});

	# ~~~ setUTCHours

	$proto->prop({
		name  => 'setDate',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setDate',
			argnames => ['date'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setDate cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $d = defined $_[1] ? $_[1]->to_number->value
			    : sin 9**9**9;
			  if($d != $d) {
			   $_[0]{value} = $d;
			   return JE::Number->new($global,$d)
			  }
			  my $v = _gm2local $${$_[0]}{value};
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _local2gm _make_date
			      _make_day(
			        _year_from_time $v,
			        _month_from_time $v,
			        $d
			      ),
			      _time_within_day $v
			  );
			},
		}),
		dontenum => 1,
	});

	# ~~~ setUTCDate

	$proto->prop({
		name  => 'setMonth',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setMonth',
			argnames => ['month','date'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setMonth cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $m = defined $_[1] ? $_[1]->to_number->value
			    : sin 9**9**9;
			  if($m != $m) {
			   $_[0]{value} = sin 9**9**9;
			   return JE::Number->new($global,sin 9**9**9)
			  }
			  my $v = _gm2local $${$_[0]}{value};
			  my $d =
			   defined $_[2]
			   ? $_[2]->to_number->value
			   : _date_from_time $v;
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _local2gm _make_date
			      _make_day(
			        _year_from_time $v,
			        $m,
			        $d
			      ),
			      _time_within_day $v
			  );
			},
		}),
		dontenum => 1,
	});

	# ~~~ setUTCMonth

	$proto->prop({
		name  => 'setYear',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'setMilliseconds',
			argnames => ['ms'],
			no_proto => 1,
			function_args => ['this','args'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "setYear cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $y = defined $_[1] ? $_[1]->to_number->value
			    : sin 9**9**9;
			  if($y != $y) {
			   $_[0]{value} = $y; return JE::Number->new($y)
			  }
			  my $inty = int $y;
			  $inty >= 0 && $inty <= 99 and $y = $inty+1900;
			  my $v = _gm2local $${$_[0]}{value};
			  $v == $v or $v = 0;
			  JE::Number->new( $global, $${$_[0]}{value} = 
			    _time_clip _local2gm _make_date
			      _make_day(
			        $y,
			        _month_from_time $v,
			        _date_from_time $v
			      ),
			      _time_within_day $v
			  );
			},
		}),
		dontenum => 1,
	});


	# ~~~ setFullYear
	# ~~~ setUTCFullYear

	my $tgs = $proto->prop({
		name  => 'toGMTString',
		value => JE::Object::Function->new({
			scope  => $global,
			name    => 'toGMTString',
			no_proto => 1,
			function_args => ['this'],
			function => sub {
			  die JE::Object::Error::TypeError->new($global,
			    add_line_number "toGMTString cannot be" .
			      " called on an object of type"
			      . shift->class)
			    unless $_[0]->isa('JE::Object::Date');
			  my $v = $${+shift}{value};
			  JE::String->_new( $global,
			    sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT",
			      $days[_week_day $v], _date_from_time $v,
			      $mon[_month_from_time $v],
			      _year_from_time $v, _hours_from_time $v,
			      _min_from_time $v, _sec_from_time $v
			  );
			},
		}),
		dontenum => 1,
	});
	$proto->prop(
		{name => toUTCString => value => $tgs => dontenum => 1}
	);

	weaken $global;
	$f;
}



return "a true value";