File Coverage

blib/lib/JE/Object/Date.pm
Criterion Covered Total %
statement 439 467 94.0
branch 244 270 90.3
condition 36 65 55.3
subroutine 79 82 96.3
pod 3 4 75.0
total 801 888 90.2


line stmt bran cond sub pod time code
1             package JE::Object::Date;
2              
3             our $VERSION = '0.066';
4              
5              
6 2     2   1464 use strict;
  2         5  
  2         96  
7 2     2   13 use warnings; no warnings 'utf8';
  2     2   3  
  2         73  
  2         9  
  2         4  
  2         91  
8              
9 2     2   12 use JE::Code 'add_line_number';
  2         4  
  2         152  
10             #use Memoize;
11 2     2   9 use POSIX 'floor';
  2         4  
  2         17  
12 2     2   158 use Scalar::Util 1.1 qw'blessed weaken looks_like_number';
  2         53  
  2         128  
13 2     2   22 use Time::Local 'timegm_nocheck';
  2         4440  
  2         175  
14 2     2   28 use Time::Zone 'tz_local_offset';
  2         4104  
  2         208  
15              
16             our @ISA = 'JE::Object';
17              
18             ##require JE::Number;
19             require JE::Object;
20             require JE::Object::Error::TypeError;
21             require JE::Object::Function;
22             require JE::String;
23              
24 2     2   12 use constant EPOCH_OFFSET => timegm_nocheck(0,0,0,1,0,1970);
  2         4  
  2         7  
25              
26             =head1 NAME
27              
28             JE::Object::Date - JavaScript Date object class
29              
30             =head1 SYNOPSIS
31              
32             use JE;
33              
34             $j = new JE;
35              
36             $js_date = new JE::Object::Date $j;
37              
38             $js_date->value; # 1174886940.466
39             "$js_date"; # Sun Mar 25 22:29:00 2007 -0700
40              
41             =head1 DESCRIPTION
42              
43             This class implements JavaScript Date objects for JE.
44              
45             =head1 METHODS
46              
47             See L and L for descriptions of most of the methods.
48             Only what
49             is specific to JE::Object::Date is explained here.
50              
51             =over
52              
53             =cut
54              
55             my %mon_numbers = qw/ Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5 Jul 6 Aug 7 Sep 8
56             Oct 9 Nov 10 Dec 11 /;
57              
58             sub new {
59 615     615 1 1229 my($class, $global) = (shift, shift);
60 615   33     4232 my $self = $class->SUPER::new($global, {
61             prototype => $global->prototype_for('Date')
62             || $global->prop('Date')->prop('prototype')
63             });
64              
65 615 50 66     5495 if (@_ >= 2) {
    100          
    100          
    100          
66 186         422 my($year,$month,$date,$hours,$minutes,$seconds,$ms) = @_;
67 186         502 for($year,$month) {
68             defined()
69 372 50 33     4287 ? defined blessed $_ && $_->can('to_number') &&
70             ($_ = $_->to_number->value)
71             : ($_ = sin 9**9**9);
72             }
73 186 100 33     1548 defined $date
74             ? defined blessed $date && $date->can('to_number') &&
75             ($date = $date->to_number->value)
76             : ($date = 1);
77 186         394 for($hours,$minutes,$seconds,$ms) {
78 2     2   596 no warnings 'uninitialized'; # undef --> 0
  2         5  
  2         852  
79 744 100 66     3159 $_ = defined blessed $_ && (can $_ 'to_number')
80             ? $_->to_number->value
81             : 0+$_;
82             }
83 186 100 100     1208 $year >= 0 and int($year) <= 99 and $year += 1900;
84 186         650 $$$self{value} = _time_clip(_local2gm(_make_date(
85             _make_day($year,$month,$date),
86             _make_time($hours,$minutes,$seconds,$ms),
87             )));
88            
89             }
90             elsif (@_ and
91             defined blessed $_[0]
92             ? (my $prim = $_[0]->to_primitive)->isa('JE::String')
93             : !looks_like_number $_[0]) {
94 8         179 $$$self{value} = _parse_date("$_[0]");
95            
96             } elsif(@_) {
97 362 50 33     4194 $$$self{value} = _time_clip (
    50          
98             defined $_[0]
99             ? defined blessed $_[0]
100             && $_[0]->can('to_number')
101             ? $_[0]->to_number->value
102             : 0+$_[0]
103             : 0
104             );
105             } else {
106 59         696 require Time::HiRes;
107 59         4510 $$$self{value} =
108             int +(Time::HiRes::time() - EPOCH_OFFSET) * 1000;
109             }
110 615         4271 $self;
111             }
112              
113              
114              
115              
116             =item value
117              
118             Returns the date as the number of seconds since the epoch, with up to three
119             decimal places.
120              
121             =cut
122              
123 0     0 1 0 sub value { $${$_[0]}{value}/1000 + EPOCH_OFFSET }
  0         0  
124              
125              
126              
127             =item class
128              
129             Returns the string 'Date'.
130              
131             =cut
132              
133 97     97 1 408 sub class { 'Date' }
134              
135              
136              
137 114 100   114 0 217 sub to_primitive { SUPER::to_primitive{shift}@_?@_:'string' }
  114         652  
138              
139              
140             =back
141              
142             =head1 SEE ALSO
143              
144             L, L, L
145              
146             =cut
147              
148              
149             # Most of these functions were copied directly from ECMA-262. Those were
150             # not optimised for speed, but apparently either for clarity or obfusca-
151             # tion--I’ve yet to ascertain which. These need to be optimized, and many
152             # completely rewritten.
153              
154             # ~~~ Are these useful enough to export them?
155             sub MS_PER_DAY() { 86400000 }
156 2         2 use constant LOCAL_TZA => do {
157             # ~~~ I need to test this by subtracting 6 mumps -- but how?
158 2         11 my $time = time;
159 2         8 1000 * (tz_local_offset($time) - (localtime $time)[8] * 3600)
160 2     2   11 };
  2         3  
161              
162             # ~~~ I still need to figure which of these (if any) actually benefit from
163             # memoisation.
164              
165             # This stuff was is based on code from Time::Local 1.11, with various
166             # changes (particularly the removal of stuff we don’t need).
167             my @MonthDays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
168             my %Cheat;
169             sub _daygm {
170 297   66 297   2502 $_[3] + ($Cheat{(),@_[4,5]} ||= do {
171 64         207 my $month = ($_[4] + 10) % 12;
172 64         198 my $year = $_[5] - int $month/10;
173 64         783 365*$year + floor($year/4) - floor($year/100) + floor($year/400) +
174             int(($month*306 + 5)/10) - 719469
175             });
176             }
177             sub _timegm {
178 297     297   694 my ($sec,$min,$hour,$mday,$month,$year) = @_;
179              
180 297         869 my $days = _daygm(undef, undef, undef, $mday, $month, $year);
181 297         992 my $xsec = $sec + 60*$min + 3600*$hour;
182              
183 297         1553 $xsec + 86400 * $days;
184             }
185              
186              
187 1248     1248   4824 sub _day($) { floor $_[0] / MS_PER_DAY }
188 68     68   239 sub _time_within_day($) { $_[0] % MS_PER_DAY }
189             sub _days_in_year($) {
190 2309   66 2309   11891 365 + not $_[0] % 4 || !($_[0] % 100) && $_[0] % 400
191             }
192             sub _day_from_year($) {
193 4839     4839   6118 my $y = shift;
194 4839         63339 365 * ($y - 1970) + floor(($y - 1969) / 4) -
195             floor(($y - 1901) / 100) + floor(($y - 1601) / 400)
196             }
197 2448     2448   3259 sub _time_from_year($) { MS_PER_DAY * &_day_from_year }
198             sub _div($$) {
199 14630     14630   19547 my $mod = $_[0] % $_[1];
200 14630         36984 return +($_[0] - $mod) / $_[1], $mod;
201             }
202             sub _year_from_time($) {
203             # This line adjusts the time so that 1/Mar/2000 is 0, and
204             # 29/Feb/2400, the extra leap day in the quadricentennium, is the
205             # last day therein. (So a qcm is 4 centuries + 1 leap day.)
206 3648     3648   6218 my $time = $_[0] - 951868800_000;
207              
208 3648         6788 (my $prec, $time) = _div $time, MS_PER_DAY * (400 * 365 + 97);
209 3648         6337 $prec *= 400; # number of years preceding the current quadri-
210             # centennium
211              
212             # Divide by a century and we have centuries preceding the current
213             # century and the time within the century, unless $tmp == 4, ...
214 3648         5613 (my $tmp, $time) = _div $time, MS_PER_DAY * (100 * 365 + 24);
215 3648 100       9585 if($tmp == 4) { # ... in which case we already know the year, since
216             # this is the last day of a qcm
217 3         20 return $prec + 400 + 2000;
218             }
219 3645         5130 $prec += $tmp * 100; # preceding the current century
220            
221             # A century is 24 quadrennia followed by four non-leap years, or,
222             # since we are starting with March, 25 quadrennia with one day
223             # knocked off the end. So no special casing is needed here.
224 3645         5308 ($tmp, $time) = _div $time, MS_PER_DAY * (4 * 365 + 1);
225 3645         5837 $prec += $tmp * 4; # preceding the current quadrennium
226            
227 3645         5650 ($tmp, $time) = _div $time, MS_PER_DAY * 365;
228             # Same special case we encountered when dividing qcms, since there
229             # is an extra day on the end.
230 3645 100       8650 if($tmp == 4) {
231 24         85 return $prec + 4 + 2000;
232             }
233 3621         11914 $prec + 2000 + $tmp + # Add 1 if we are past Dec.:
234             ($time >= (31+30+31+30+31+31+30+31+30+31) * MS_PER_DAY);
235             # days from Mar 1 to Jan 1
236             }
237 1028     1028   1693 sub _in_leap_year($) { _days_in_year &_year_from_time == 366 }
238 1112     1112   1784 sub _day_within_year($) { &_day - _day_from_year &_year_from_time }
239             sub _month_from_time($) {
240 710     710   1325 my $dwy = &_day_within_year;
241 710         1620 my $ily = &_in_leap_year;
242 710 100       2357 return 0 if $dwy < 31;
243 608         700 my $counter = 1;
244 608         1279 for (qw/59 90 120 151 181 212 243 273 304 334 365/) {
245 3860 100       8237 return $counter if $dwy < $_ + $ily;
246 3252         4002 ++$counter;
247             }
248             }
249             sub _date_from_time($) {
250 402     402   1004 my $dwy = &_day_within_year;
251 402         1099 my $mft = &_month_from_time;
252 402 100       1075 return $dwy+1 unless $mft;
253 345 100       904 return $dwy-30 if $mft == 1;
254 318         1014 return $dwy - qw/0 0 58 89 119 150 180 211 242 272 303 333/[$mft]
255             - &_in_leap_year;
256             }
257 98     98   252 sub _week_day($) { (&_day + 4) % 7 }
258              
259             # $_dumdeedum[0] will contain the nearest non-leap-year that begins on Sun-
260             # day, $_dumdeedum[1] the nearest beginning on Monday, etc.
261             # @_dumdeedum[7..15] are for leap years.
262             # For the life of me I can't think of a name for this array!
263             {
264             my @_dumdeedum;
265              
266             my $this_year = (gmtime(my $time = time))[5]+1900;
267             $_dumdeedum[_week_day(_time_from_year _year_from_time $time*1000) +
268             7 * (_days_in_year($this_year)==366) ] = $this_year;
269              
270             my $next_past = my $next_future = $this_year;
271             my $count = 1; my $index;
272             while ($count < 14) {
273             $index = (_day_from_year(--$next_past) + 4) % 7 +
274             7 * (_days_in_year($next_past)==366);
275             unless (defined $_dumdeedum[$index]) {
276             $_dumdeedum[$index] = $next_past;
277             ++$count;
278             }
279             $index = (_day_from_year(++$next_future) + 4) % 7 +
280             7 * (_days_in_year($next_future)==366);
281             unless (defined $_dumdeedum[$index]) {
282             $_dumdeedum[$index] = $next_future;
283             ++$count;
284             }
285             }
286             # The spec requires that the same formula for daylight savings be used for
287             # all years. An ECMAScript implementation is not allowed to take into
288             # account that the formula might have changed in the past. That's what the
289             # @_dumdeedum array is for. The spec basically allows for fourteen differ-
290             # ent possibilities for the dates for daylight savings time change. The
291             # code above collects the 'nearest' fourteen years that are not equivalent
292             # to each other.
293              
294             sub _ds_time_adjust($) {
295 1223     1223   3241 my $year = _year_from_time(my $time = $_[0]);
296 1223         2596 my $ddd_index = (_day_from_year($year) + 4) % 7 +
297             7 * (_days_in_year $year == 366);
298 1223         2812 my $time_within_year = $time - _time_from_year $year;
299             (localtime
300             +(
301 1223         3115 $time_within_year +
302             _time_from_year $_dumdeedum[$ddd_index]
303             ) / 1000 # convert to seconds
304             + EPOCH_OFFSET
305             )[8] * 3600_000
306             }
307             }
308              
309             sub _gm2local($) {
310             # shortcut for nan & inf to avoid localtime(nan) warning
311 1006 50 33 1006   6313 return $_[0] unless $_[0] == $_[0] and $_[0]+1 != $_[0];
312              
313 1006         2559 $_[0] + LOCAL_TZA + &_ds_time_adjust
314             }
315              
316             sub _local2gm($) {
317             # shortcut for nan & inf to avoid localtime(nan) warning
318 231 100 100 231   1540 return $_[0] unless $_[0] == $_[0] and $_[0]+1 != $_[0];
319              
320 217         854 $_[0] - LOCAL_TZA - _ds_time_adjust $_[0] - LOCAL_TZA
321             }
322              
323 229     229   1604 sub _hours_from_time($) { floor($_[0] / 3600_000) % 24 }
324 221     221   1492 sub _min_from_time($) { floor($_[0] / 60_000) % 60 }
325 225     225   1598 sub _sec_from_time($) { floor($_[0] / 1000) % 60 }
326 192     192   949 sub _ms_from_time($) { $_[0] % 1000 }
327              
328             sub _make_time($$$$) {
329 268     268   723 my ($hour, $min, $sec, $ms) = @_;
330 268         806 for(\($hour, $min, $sec, $ms)) {
331 1060 100 100     3845 $$_ + 1 == $$_ or $$_ != $$_ and return sin 9**9**9;
332 1054         1884 $$_ = int $$_; # ~~~ Is this necessary? Is it sufficient?
333             }
334 262         1434 $hour * 3600_000 +
335             $min * 60_000 +
336             $sec * 1000 +
337             $ms;
338             }
339              
340             sub _make_day($$$) {
341 298     298   546 my ($year, $month, $date) = @_;
342 298         771 for(\($year, $month, $date)) {
343 877 100 100     3073 $$_ + 1 == $$_ or $$_ != $$_ and return sin 9**9**9;
344 865         1622 $$_ = int $$_; # ~~~ Is it sufficient?
345             }
346 286         1431 $year += floor($month/12);
347 286         591 $month %= 12;
348 286         1018 _timegm(0,0,0,$date,$month,$year)
349             /
350             (MS_PER_DAY/1000)
351             }
352              
353             sub _make_date($$) {
354 336     336   751 my ($day, $time) = @_;
355 336         740 for(\($day, $time)) {
356 655 100 100     2855 $$_ + 1 == $$_ or $$_ != $$_ and return sin 9**9**9;
357             }
358 317         1370 $day * MS_PER_DAY + $time
359             }
360              
361             sub _time_clip($) {
362 702     702   1293 my ($time) = @_;
363 702 100 100     3356 $time + 1 == $time or $time != $time and return sin 9**9**9;
364 665 100       1899 abs($time) > 8.64e15 and return sin 9**9**9;
365 648         2762 int $time
366             }
367              
368             sub _parse_date($) {
369             # If the date matches the format output by
370             # to(GMT|UTC|Locale)?String, we need to parse it ourselves.
371             # Otherwise, we pass it on to Date::Parse, and live with
372             # the latter’s limited range.
373             # ~~~ (Maybe I should change this to use
374             # DateTime::Format::Natural.)
375              
376 19     19   33 my $str = shift;
377 19         198 my $time;
378 19 100       166 if($str =~ /^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
    100          
379             (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]
380             ([ \d]\d)\ (\d\d):(\d\d):(\d\d)\ (\d{4,})
381             [ ]([+-]\d{2})(\d{2})
382             \z/x) {
383 7         51 $time = _timegm($5,$4,$3,$2,$mon_numbers{$1},$6)
384             + $7*-3600 + $8*60;
385             } elsif($str =~ /^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat),[ ]
386             (\d\d?)[ ]
387             (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]
388             (\d{4,})\ (\d\d):(\d\d):(\d\d)\ GMT
389             \z/x) {
390 4         31 $time = _timegm($6,$5,$4,$1,$mon_numbers{$2},$3);
391             } else {
392 8         80 require Date::Parse;
393 8 100       3129 if(defined($time = Date::Parse::str2time($str))) {
394 5         1778 $time -= EPOCH_OFFSET
395             }
396             }
397 19 100       835 defined $time ? $time * 1000 :
398             sin 9**9**9;
399             }
400              
401             my @days = qw/ Sun Mon Tue Wed Thu Fri Sat Sun /;
402             my @mon = qw/ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /;
403             sub _new_constructor {
404 2     2   4 () = (@days, @mon); # work-around for perl bug #16302
405 2         6 my $global = shift;
406             my $f = JE::Object::Function->new({
407             name => 'Date',
408             scope => $global,
409             argnames => [qw/year month date hours minutes
410             seconds ms/],
411             function => sub {
412 2     2   4 my $time = time;
413 2         12 my $offset = tz_local_offset($time);
414 2         123 my $sign = qw/- +/[$offset >= 0];
415 2         55 return JE::String->_new($global,
416             localtime($time) . " $sign" .
417             sprintf '%02d%02d',
418             _div abs($offset)/60, 60
419             );
420             },
421             function_args => [],
422             constructor => sub {
423 615     615   2180 unshift @_, __PACKAGE__;
424 615         2546 goto &new;
425             },
426 2         54 constructor_args => ['scope','args'],
427             });
428              
429             $f->prop({
430             name => 'parse',
431             value => JE::Object::Function->new({
432             scope => $global,
433             name => 'parse',
434             argnames => ['string'],
435             no_proto => 1,
436             function_args => ['args'],
437             function => sub {
438 12     12   20 my $str = shift;
439 12 100       77 JE::Number->new($global,
440             defined $str
441             ? _parse_date $str->to_string->value
442             : 'nan'
443             );
444             },
445 2         20 }),
446             dontenum => 1,
447             });
448              
449             $f->prop({
450             name => 'UTC',
451             value => JE::Object::Function->new({
452             scope => $global,
453             name => 'UTC',
454             argnames => [qw 'year month date hours minutes
455             seconds ms' ],
456             no_proto => 1,
457             function_args => ['args'],
458             function => sub {
459 44     44   103 my($year,$month,$date,$hours,$minutes,$seconds,$ms) = @_;
460 44         98 for($year,$month) {
461 88 100       357 $_ = defined() ? $_->to_number->value : sin 9**9**9
462             }
463 44 100       168 $date = defined $date ? $date->to_number->value : 1;
464 44         85 for($hours,$minutes,$seconds,$ms) {
465 176 100       440 $_ = defined $_ ? $_->to_number->value : 0;
466             }
467 44 100 100     257 $year >= 0 and int($year) <= 99 and $year += 1900;
468 44         139 JE::Number->new($global,
469             _time_clip(_make_date(
470             _make_day($year,$month,$date),
471             _make_time($hours,$minutes,$seconds,$ms),
472             ))
473             );
474             },
475 2         22 }),
476             dontenum => 1,
477             });
478              
479 2         15 my $proto = bless $f->prop({
480             name => 'prototype',
481             dontenum => 1,
482             readonly => 1,
483             }), __PACKAGE__;
484 2         10 $global->prototype_for('Date'=>$proto);
485              
486 2         121 $$$proto{value} = sin 9**9**9;
487              
488             $proto->prop({
489             name => 'toString',
490             value => JE::Object::Function->new({
491             scope => $global,
492             name => 'toString',
493             no_proto => 1,
494             function_args => ['this'],
495             function => sub {
496 44 100   44   361 die JE::Object::Error::TypeError->new($global,
497             add_line_number
498             "Arg to toString ($_[0]) is not a date")
499             unless $_[0]->isa('JE::Object::Date');
500             # Can’t use localtime because of its lim-
501             # ited range.
502 42         78 my $v = $${+shift}{value};
  42         164  
503 42         148 my $time = _gm2local $v;
504 42         134 my $offset = ($time - $v) / 60_000;
505 42         142 my $sign = qw/- +/[$offset >= 0];
506 42         153 return JE::String->_new($global,
507             sprintf
508             '%s %s %2d %02d:%02d:%02d %04d %s%02d%02d',
509             $days[_week_day $time], # Mon
510             $mon[_month_from_time $time], # Dec
511             _date_from_time $time, # 31
512             _hours_from_time $time, # 11:42:40
513             _min_from_time $time,
514             _sec_from_time $time,
515             _year_from_time $time, # 2007
516             $sign, # -
517             _div abs($offset), 60 # 0800
518             );
519             },
520 2         19 }),
521             dontenum => 1,
522             });
523              
524             $proto->prop({
525             name => 'toDateString',
526             value => JE::Object::Function->new({
527             scope => $global,
528             name => 'toString',
529             no_proto => 1,
530             function_args => ['this'],
531             function => sub {
532 42 100   42   326 die JE::Object::Error::TypeError->new($global,
533             add_line_number
534             "Arg to toDateString ($_[0]) is not a date")
535             unless $_[0]->isa('JE::Object::Date');
536 40         67 my $time = _gm2local $${+shift}{value};
  40         188  
537 40         205 return JE::String->_new($global,
538             sprintf
539             '%s %s %d %04d',
540             $days[_week_day $time], # Mon
541             $mon[_month_from_time $time], # Dec
542             _date_from_time $time, # 31
543             _year_from_time $time, # 2007
544             );
545             },
546 2         21 }),
547             dontenum => 1,
548             });
549              
550             $proto->prop({
551             name => 'toTimeString',
552             value => JE::Object::Function->new({
553             scope => $global,
554             name => 'toTimeString',
555             no_proto => 1,
556             function_args => ['this'],
557             function => sub {
558 4 100   4   47 die JE::Object::Error::TypeError->new($global,
559             add_line_number
560             "Arg to toTimeString ($_[0]) is not a date")
561             unless $_[0]->isa('JE::Object::Date');
562 2         6 my $time = _gm2local $${+shift}{value};
  2         9  
563 2         10 return JE::String->_new($global,
564             sprintf
565             '%02d:%02d:%02d',
566             _hours_from_time $time,
567             _min_from_time $time,
568             _sec_from_time $time,
569             );
570             },
571 2         19 }),
572             dontenum => 1,
573             });
574              
575             # ~~~ How exactly should I make these three behave? Should I leave
576             # them as they is?
577 2         8 $proto->prop({
578             name => 'toLocaleString',
579             value => $proto->prop('toString'),
580             dontenum => 1,
581             });
582 2         6 $proto->prop({
583             name => 'toLocaleDateString',
584             value => $proto->prop('toDateString'),
585             dontenum => 1,
586             });
587 2         7 $proto->prop({
588             name => 'toLocaleTimeString',
589             value => $proto->prop('toTimeString'),
590             dontenum => 1,
591             });
592              
593             $proto->prop({
594             name => 'valueOf',
595             value => JE::Object::Function->new({
596             scope => $global,
597             name => 'valueOf',
598             no_proto => 1,
599             function_args => ['this'],
600             function => sub {
601 133 100   133   705 die JE::Object::Error::TypeError->new($global,
602             add_line_number
603             "Arg to valueOf ($_[0]) is not a date")
604             unless $_[0]->isa('JE::Object::Date');
605 132         554 JE::Number->new(
606 132         257 $global,$${+shift}{value}
607             );
608             },
609 2         15 }),
610             dontenum => 1,
611             });
612              
613             $proto->prop({
614             name => 'getTime',
615             value => JE::Object::Function->new({
616             scope => $global,
617             name => 'getTime',
618             no_proto => 1,
619             function_args => ['this'],
620             function => sub {
621 94 100   94   470 $_[0]->class eq 'Date' or die
622             JE'Object'Error'TypeError->new(
623             $global,
624             "getTime cannot be called".
625             " on an object of type " .
626             shift->class
627             );
628 93         423 JE::Number->new(
629 93         195 $global,$${+shift}{value}
630             );
631             },
632 2         19 }),
633             dontenum => 1,
634             });
635              
636             $proto->prop({
637             name => 'getYear',
638             value => JE::Object::Function->new({
639             scope => $global,
640             name => 'getYear',
641             no_proto => 1,
642             function_args => ['this'],
643             function => sub {
644 62 50   62   316 die JE::Object::Error::TypeError->new($global,
645             add_line_number
646             "Arg to getYear ($_[0]) is not a date")
647             unless $_[0]->isa('JE::Object::Date');
648 62         68 my $v = $${+shift}{value};
  62         180  
649 62 50       196 $v == $v or return JE::Number->new($global,$v);
650 62         160 JE::Number->new( $global,
651             _year_from_time(_gm2local $v) - 1900
652             );
653             },
654 2         21 }),
655             dontenum => 1,
656             });
657              
658             $proto->prop({
659             name => 'getFullYear',
660             value => JE::Object::Function->new({
661             scope => $global,
662             name => 'getFullYear',
663             no_proto => 1,
664             function_args => ['this'],
665             function => sub {
666 32 100   32   200 die JE::Object::Error::TypeError->new($global,
667             add_line_number
668             "Arg to getFullYear ($_[0]) is not a date")
669             unless $_[0]->isa('JE::Object::Date');
670 31         35 my $v = $${+shift}{value};
  31         95  
671 31 100       108 $v == $v or return JE::Number->new($global,$v);
672 30         83 JE::Number->new( $global,
673             _year_from_time(_gm2local $v)
674             );
675             },
676 2         19 }),
677             dontenum => 1,
678             });
679              
680             $proto->prop({
681             name => 'getUTCFullYear',
682             value => JE::Object::Function->new({
683             scope => $global,
684             name => 'getUTCFullYear',
685             no_proto => 1,
686             function_args => ['this'],
687             function => sub {
688 75 100   75   370 die JE::Object::Error::TypeError->new($global,
689             add_line_number "getUTCFullYear cannot be " .
690             "called on an object of type " . $_[0]->class)
691             unless $_[0]->isa('JE::Object::Date');
692 74         78 my $v = $${+shift}{value};
  74         217  
693 74 100       226 $v == $v or return JE::Number->new($global,$v);
694 73         224 JE::Number->new( $global,
695             _year_from_time( $v)
696             );
697             },
698 2         18 }),
699             dontenum => 1,
700             });
701              
702              
703             $proto->prop({
704             name => 'getMonth',
705             value => JE::Object::Function->new({
706             scope => $global,
707             name => 'getMonth',
708             no_proto => 1,
709             function_args => ['this'],
710             function => sub {
711 116 100   116   585 die JE::Object::Error::TypeError->new($global,
712             add_line_number
713             "Arg to getMonth ($_[0]) is not a date")
714             unless $_[0]->isa('JE::Object::Date');
715 115         139 my $v = $${+shift}{value};
  115         381  
716 115 100       367 $v == $v or return JE::Number->new($global,$v);
717 114         384 JE::Number->new( $global,
718             _month_from_time(_gm2local $v)
719             );
720             },
721 2         20 }),
722             dontenum => 1,
723             });
724              
725             $proto->prop({
726             name => 'getUTCMonth',
727             value => JE::Object::Function->new({
728             scope => $global,
729             name => 'getUTCMonth',
730             no_proto => 1,
731             function_args => ['this'],
732             function => sub {
733 104 100   104   563 die JE::Object::Error::TypeError->new($global,
734             add_line_number "getUTCMonth cannot be called".
735             " on an object of type " . $_[0]->class)
736             unless $_[0]->isa('JE::Object::Date');
737 103         137 my $v = $${+shift}{value};
  103         335  
738 103 100       330 $v == $v or return JE::Number->new($global,$v);
739 102         295 JE::Number->new( $global,
740             _month_from_time($v)
741             );
742             },
743 2         18 }),
744             dontenum => 1,
745             });
746              
747             $proto->prop({
748             name => 'getDate',
749             value => JE::Object::Function->new({
750             scope => $global,
751             name => 'getDate',
752             no_proto => 1,
753             function_args => ['this'],
754             function => sub {
755 142 100   142   754 die JE::Object::Error::TypeError->new($global,
756             add_line_number
757             "getDate cannot be called on an object of type"
758             . shift->class)
759             unless $_[0]->isa('JE::Object::Date');
760 141         127 my $v = $${+shift}{value};
  141         396  
761 141 100       395 $v == $v or return JE::Number->new($global,$v);
762 140         356 JE::Number->new( $global,
763             _date_from_time(_gm2local $v)
764             );
765             },
766 2         25 }),
767             dontenum => 1,
768             });
769              
770             $proto->prop({
771             name => 'getUTCDate',
772             value => JE::Object::Function->new({
773             scope => $global,
774             name => 'getUTCDate',
775             no_proto => 1,
776             function_args => ['this'],
777             function => sub {
778 128 100   128   560 die JE::Object::Error::TypeError->new($global,
779             add_line_number "getUTCDate cannot be called ".
780             "on an object of type"
781             . shift->class)
782             unless $_[0]->isa('JE::Object::Date');
783 127         133 my $v = $${+shift}{value};
  127         333  
784 127 100       369 $v == $v or return JE::Number->new($global,$v);
785 126         364 JE::Number->new( $global,
786             _date_from_time($v)
787             );
788             },
789 2         25 }),
790             dontenum => 1,
791             });
792              
793             $proto->prop({
794             name => 'getDay',
795             value => JE::Object::Function->new({
796             scope => $global,
797             name => 'getDay',
798             no_proto => 1,
799             function_args => ['this'],
800             function => sub {
801 9 100   9   45 die JE::Object::Error::TypeError->new($global,
802             add_line_number
803             "getDay cannot be called on an object of type"
804             . shift->class)
805             unless $_[0]->isa('JE::Object::Date');
806 8         8 my $v = $${+shift}{value};
  8         21  
807 8 100       20 $v == $v or return JE::Number->new($global,$v);
808 7         16 JE::Number->new( $global,
809             _week_day(_gm2local $v)
810             );
811             },
812 2         19 }),
813             dontenum => 1,
814             });
815              
816             $proto->prop({
817             name => 'getUTCDay',
818             value => JE::Object::Function->new({
819             scope => $global,
820             name => 'getUTCDay',
821             no_proto => 1,
822             function_args => ['this'],
823             function => sub {
824 9 100   9   42 die JE::Object::Error::TypeError->new($global,
825             add_line_number "getUTCDay cannot be called ".
826             "on an object of type"
827             . shift->class)
828             unless $_[0]->isa('JE::Object::Date');
829 8         9 my $v = $${+shift}{value};
  8         18  
830 8 100       21 $v == $v or return JE::Number->new($global,$v);
831 7         17 JE::Number->new( $global,
832             _week_day($v)
833             );
834             },
835 2         25 }),
836             dontenum => 1,
837             });
838              
839             $proto->prop({
840             name => 'getHours',
841             value => JE::Object::Function->new({
842             scope => $global,
843             name => 'getHours',
844             no_proto => 1,
845             function_args => ['this'],
846             function => sub {
847 88 100   88   439 die JE::Object::Error::TypeError->new($global,
848             add_line_number
849             "getHours cannot be called on an object of type"
850             . shift->class)
851             unless $_[0]->isa('JE::Object::Date');
852 87         182 my $v = $${+shift}{value};
  87         301  
853 87 100       297 $v == $v or return JE::Number->new($global,$v);
854 86         244 JE::Number->new( $global,
855             _hours_from_time(_gm2local $v)
856             );
857             },
858 2         24 }),
859             dontenum => 1,
860             });
861              
862             $proto->prop({
863             name => 'getUTCHours',
864             value => JE::Object::Function->new({
865             scope => $global,
866             name => 'getUTCHours',
867             no_proto => 1,
868             function_args => ['this'],
869             function => sub {
870 75 100   75   418 die JE::Object::Error::TypeError->new($global,
871             add_line_number "getUTCHours cannot be called".
872             " on an object of type"
873             . shift->class)
874             unless $_[0]->isa('JE::Object::Date');
875 74         72 my $v = $${+shift}{value};
  74         258  
876 74 100       311 $v == $v or return JE::Number->new($global,$v);
877 73         233 JE::Number->new( $global,
878             _hours_from_time($v)
879             );
880             },
881 2         29 }),
882             dontenum => 1,
883             });
884              
885             $proto->prop({
886             name => 'getMinutes',
887             value => JE::Object::Function->new({
888             scope => $global,
889             name => 'getMinutes',
890             no_proto => 1,
891             function_args => ['this'],
892             function => sub {
893 87 100   87   434 die JE::Object::Error::TypeError->new($global,
894             add_line_number "getMinutes cannot be called" .
895             " on an object of type"
896             . shift->class)
897             unless $_[0]->isa('JE::Object::Date');
898 86         91 my $v = $${+shift}{value};
  86         273  
899 86 100       268 $v == $v or return JE::Number->new($global,$v);
900 85         217 JE::Number->new( $global,
901             _min_from_time(_gm2local $v)
902             );
903             },
904 2         18 }),
905             dontenum => 1,
906             });
907              
908             $proto->prop({
909             name => 'getUTCMinutes',
910             value => JE::Object::Function->new({
911             scope => $global,
912             name => 'getUTCMinutes',
913             no_proto => 1,
914             function_args => ['this'],
915             function => sub {
916 74 100   74   350 die JE::Object::Error::TypeError->new($global,
917             add_line_number "getUTCMinutes cannot be " .
918             "called on an object of type"
919             . shift->class)
920             unless $_[0]->isa('JE::Object::Date');
921 73         101 my $v = $${+shift}{value};
  73         245  
922 73 100       272 $v == $v or return JE::Number->new($global,$v);
923 72         238 JE::Number->new( $global,
924             _min_from_time($v)
925             );
926             },
927 2         20 }),
928             dontenum => 1,
929             });
930              
931             $proto->prop({
932             name => 'getSeconds',
933             value => JE::Object::Function->new({
934             scope => $global,
935             name => 'getSeconds',
936             no_proto => 1,
937             function_args => ['this'],
938             function => sub {
939 165 100   165   847 die JE::Object::Error::TypeError->new($global,
940             add_line_number "getSeconds cannot be called" .
941             " on an object of type"
942             . shift->class)
943             unless $_[0]->isa('JE::Object::Date');
944 163         201 my $v = $${+shift}{value};
  163         553  
945 163 100       734 $v == $v or return JE::Number->new($global,$v);
946 161         487 JE::Number->new( $global,
947             _sec_from_time(_gm2local $v)
948             );
949             },
950 2         24 }),
951             dontenum => 1,
952             });
953              
954 2         8 $proto->prop({
955             name => 'getUTCSeconds',
956             value => $proto->prop('getSeconds'),
957             dontenum => 1,
958             });
959              
960             $proto->prop({
961             name => 'getMilliseconds',
962             value => JE::Object::Function->new({
963             scope => $global,
964             name => 'getMilliseconds',
965             no_proto => 1,
966             function_args => ['this'],
967             function => sub {
968 181 100   181   1046 die JE::Object::Error::TypeError->new($global,
969             add_line_number "getMilliseconds cannot be" .
970             " called on an object of type"
971             . shift->class)
972             unless $_[0]->isa('JE::Object::Date');
973 178         186 my $v = $${+shift}{value};
  178         516  
974 178 100       639 $v == $v or return JE::Number->new($global,$v);
975 176         426 JE::Number->new( $global,
976             _ms_from_time(_gm2local $v)
977             );
978             },
979 2         17 }),
980             dontenum => 1,
981             });
982              
983 2         7 $proto->prop({
984             name => 'getUTCMilliseconds',
985             value => $proto->prop('getMilliseconds'),
986             dontenum => 1,
987             });
988              
989             $proto->prop({
990             name => 'getTimezoneOffset',
991             value => JE::Object::Function->new({
992             scope => $global,
993             name => 'getTimezoneOffset',
994             no_proto => 1,
995             function_args => ['this'],
996             function => sub {
997 16 50   16   115 die JE::Object::Error::TypeError->new($global,
998             add_line_number "getTimezoneOffset cannot be" .
999             " called on an object of type"
1000             . shift->class)
1001             unless $_[0]->isa('JE::Object::Date');
1002 16         24 my $v = $${+shift}{value};
  16         60  
1003 16 50       53 $v == $v or return JE::Number->new($global,$v);
1004 16         59 JE::Number->new( $global,
1005             ($v - _gm2local $v) / 60_000
1006             );
1007             },
1008 2         23 }),
1009             dontenum => 1,
1010             });
1011              
1012             $proto->prop({
1013             name => 'setTime',
1014             value => JE::Object::Function->new({
1015             scope => $global,
1016             name => 'setTime',
1017             argnames => ['time'],
1018             no_proto => 1,
1019             function_args => ['this','args'],
1020             function => sub {
1021 5 100   5   40 die JE::Object::Error::TypeError->new($global,
1022             add_line_number "setTime cannot be" .
1023             " called on an object of type"
1024             . shift->class)
1025             unless $_[0]->isa('JE::Object::Date');
1026 4 100       26 JE::Number->new( $global, $${$_[0]}{value} =
  4         26  
1027             _time_clip(
1028             defined $_[1] ? $_[1]->to_number->value :
1029             sin 9**9**9
1030             )
1031             );
1032             },
1033 2         35 }),
1034             dontenum => 1,
1035             });
1036              
1037             $proto->prop({
1038             name => 'setMilliseconds',
1039             value => JE::Object::Function->new({
1040             scope => $global,
1041             name => 'setMilliseconds',
1042             argnames => ['ms'],
1043             no_proto => 1,
1044             function_args => ['this','args'],
1045             function => sub {
1046 12 100   12   71 die JE::Object::Error::TypeError->new($global,
1047             add_line_number "setMilliseconds cannot be" .
1048             " called on an object of type"
1049             . shift->class)
1050             unless $_[0]->isa('JE::Object::Date');
1051 10         10 my $v = $${$_[0]}{value};
  10         24  
1052 10 100       23 JE::Number->new( $global, $${$_[0]}{value} =
  10         56  
1053             _time_clip _make_date
1054             _day $v,
1055             _make_time
1056             _hours_from_time $v,
1057             _min_from_time $v,
1058             _sec_from_time $v,
1059             defined $_[1] ? $_[1]->to_number->value :
1060             sin 9**9**9
1061             );
1062             },
1063 2         27 }),
1064             dontenum => 1,
1065             });
1066              
1067 2         9 $proto->prop({
1068             name => 'setUTCMilliseconds',
1069             value => $proto->prop('setMilliseconds'),
1070             dontenum => 1,
1071             });
1072              
1073             $proto->prop({
1074             name => 'setSeconds',
1075             value => JE::Object::Function->new({
1076             scope => $global,
1077             name => 'setSeconds',
1078             argnames => ['sec','ms'],
1079             no_proto => 1,
1080             function_args => ['this','args'],
1081             function => sub {
1082 10 100   10   83 die JE::Object::Error::TypeError->new($global,
1083             add_line_number "setSeconds cannot be" .
1084             " called on an object of type"
1085             . shift->class)
1086             unless $_[0]->isa('JE::Object::Date');
1087 8 100       47 my $s = defined $_[1] ? $_[1]->to_number->value
1088             : sin 9**9**9;
1089 8 100       36 if($s != $s) {
1090 2         11 $_[0]{value} = sin 9**9**9;
1091 2         14 return JE::Number->new($global,sin 9**9**9);
1092             }
1093 6         11 my $v = $${$_[0]}{value};
  6         20  
1094 6 100       28 my $ms =
1095             defined $_[2]
1096             ? $_[2]->to_number->value
1097             : _ms_from_time $v;
1098 6 50       23 if($ms!=$ms) {
1099 0         0 $_[0]{value} = sin 9**9**9;
1100 0         0 return JE::Number->new(sin 9**9**9);
1101             }
1102 6         25 JE::Number->new( $global, $${$_[0]}{value} =
  6         42  
1103             _time_clip _make_date
1104             _day $v,
1105             _make_time
1106             _hours_from_time $v,
1107             _min_from_time $v,
1108             $s,
1109             $ms,
1110             );
1111             },
1112 2         34 }),
1113             dontenum => 1,
1114             });
1115              
1116 2         9 $proto->prop({
1117             name => 'setUTCSeconds',
1118             value => $proto->prop('setSeconds'),
1119             dontenum => 1,
1120             });
1121              
1122             $proto->prop({
1123             name => 'setMinutes',
1124             value => JE::Object::Function->new({
1125             scope => $global,
1126             name => 'setMinutes',
1127             argnames => ['min','sec','ms'],
1128             no_proto => 1,
1129             function_args => ['this','args'],
1130             function => sub {
1131 7 100   7   54 die JE::Object::Error::TypeError->new($global,
1132             add_line_number "setMinutes cannot be" .
1133             " called on an object of type"
1134             . shift->class)
1135             unless $_[0]->isa('JE::Object::Date');
1136 6 100       33 my $m = defined $_[1] ? $_[1]->to_number->value
1137             : sin 9**9**9;
1138 6 100       27 if($m != $m) {
1139 1         6 $_[0]{value} = sin 9**9**9;
1140 1         6 return JE::Number->new($global,sin 9**9**9);
1141             }
1142 5         8 my $v = _gm2local $${$_[0]}{value};
  5         19  
1143 5 100       33 my $s =
1144             defined $_[2]
1145             ? $_[2]->to_number->value
1146             : _sec_from_time $v;
1147 5 100       24 my $ms =
1148             defined $_[3]
1149             ? $_[3]->to_number->value
1150             : _ms_from_time $v;
1151 5 50 33     40 if($s!=$s || $ms!=$ms) {
1152 0         0 $_[0]{value} = sin 9**9**9;
1153 0         0 return JE::Number->new(sin 9**9**9);
1154             }
1155 5         19 JE::Number->new( $global, $${$_[0]}{value} =
  5         33  
1156             _time_clip _local2gm _make_date
1157             _day $v,
1158             _make_time _hours_from_time $v, $m, $s, $ms
1159             );
1160             },
1161 2         24 }),
1162             dontenum => 1,
1163             });
1164              
1165             $proto->prop({
1166             name => 'setUTCMinutes',
1167             value => JE::Object::Function->new({
1168             scope => $global,
1169             name => 'setUTCMinutes',
1170             argnames => ['min','sec','ms'],
1171             no_proto => 1,
1172             function_args => ['this','args'],
1173             function => sub {
1174 7 100   7   112 die JE::Object::Error::TypeError->new($global,
1175             add_line_number "setUTCMinutes cannot be" .
1176             " called on an object of type"
1177             . shift->class)
1178             unless $_[0]->isa('JE::Object::Date');
1179 6 100       36 my $m = defined $_[1] ? $_[1]->to_number->value
1180             : sin 9**9**9;
1181 6 100       25 if($m != $m) {
1182 1         7 $_[0]{value} = sin 9**9**9;
1183 1         6 return JE::Number->new($global,sin 9**9**9);
1184             }
1185 5         13 my $v = $${$_[0]}{value};
  5         22  
1186 5 100       26 my $s =
1187             defined $_[2]
1188             ? $_[2]->to_number->value
1189             : _sec_from_time $v;
1190 5 100       26 my $ms =
1191             defined $_[3]
1192             ? $_[3]->to_number->value
1193             : _ms_from_time $v;
1194 5 50 33     44 if($s!=$s || $ms!=$ms) {
1195 0         0 $_[0]{value} = sin 9**9**9;
1196 0         0 return JE::Number->new(sin 9**9**9);
1197             }
1198 5         24 JE::Number->new( $global, $${$_[0]}{value} =
  5         33  
1199             _time_clip _make_date
1200             _day $v,
1201             _make_time _hours_from_time $v, $m, $s, $ms
1202             );
1203             },
1204 2         45 }),
1205             dontenum => 1,
1206             });
1207              
1208             $proto->prop({
1209             name => 'setHours',
1210             value => JE::Object::Function->new({
1211             scope => $global,
1212             name => 'setHours',
1213             argnames => ['hour','min','sec','ms'],
1214             no_proto => 1,
1215             function_args => ['this','args'],
1216             function => sub {
1217 8 100   8   55 die JE::Object::Error::TypeError->new($global,
1218             add_line_number "setHours cannot be" .
1219             " called on an object of type"
1220             . shift->class)
1221             unless $_[0]->isa('JE::Object::Date');
1222 7 100       38 my $h = defined $_[1] ? $_[1]->to_number->value
1223             : sin 9**9**9;
1224 7 100       29 if($h != $h) {
1225 1         6 $_[0]{value} = sin 9**9**9;
1226 1         6 return JE::Number->new($global,sin 9**9**9);
1227             }
1228 6         11 my $v = _gm2local $${$_[0]}{value};
  6         25  
1229 6 100       49 my $m =
1230             defined $_[2]
1231             ? $_[2]->to_number->value
1232             : _min_from_time $v;
1233 6 100       29 my $s =
1234             defined $_[3]
1235             ? $_[3]->to_number->value
1236             : _sec_from_time $v;
1237 6 100       37 my $ms =
1238             defined $_[4]
1239             ? $_[4]->to_number->value
1240             : _ms_from_time $v;
1241 6 50 33     93 if($m!=$m || $s!=$s || $ms!=$ms) {
      33        
1242 0         0 $_[0]{value} = sin 9**9**9;
1243 0         0 return JE::Number->new(sin 9**9**9);
1244             }
1245 6         30 JE::Number->new( $global, $${$_[0]}{value} =
  6         56  
1246             _time_clip _local2gm _make_date
1247             _day $v,
1248             _make_time $h, $m, $s, $ms
1249             );
1250             },
1251 2         28 }),
1252             dontenum => 1,
1253             });
1254              
1255             $proto->prop({
1256             name => 'setUTCHours',
1257             value => JE::Object::Function->new({
1258             scope => $global,
1259             name => 'setUTCHours',
1260             argnames => ['hour','min','sec','ms'],
1261             no_proto => 1,
1262             function_args => ['this','args'],
1263             function => sub {
1264 8 100   8   59 die JE::Object::Error::TypeError->new($global,
1265             add_line_number "setUTCHours cannot be" .
1266             " called on an object of type"
1267             . shift->class)
1268             unless $_[0]->isa('JE::Object::Date');
1269 7 100       38 my $h = defined $_[1] ? $_[1]->to_number->value
1270             : sin 9**9**9;
1271 7 100       34 if($h != $h) {
1272 1         5 $_[0]{value} = sin 9**9**9;
1273 1         6 return JE::Number->new($global,sin 9**9**9);
1274             }
1275 6         11 my $v = $${$_[0]}{value};
  6         25  
1276 6 100       35 my $m =
1277             defined $_[2]
1278             ? $_[2]->to_number->value
1279             : _min_from_time $v;
1280 6 100       38 my $s =
1281             defined $_[3]
1282             ? $_[3]->to_number->value
1283             : _sec_from_time $v;
1284 6 100       32 my $ms =
1285             defined $_[4]
1286             ? $_[4]->to_number->value
1287             : _ms_from_time $v;
1288 6 50 33     83 if($m!=$m || $s!=$s || $ms!=$ms) {
      33        
1289 0         0 $_[0]{value} = sin 9**9**9;
1290 0         0 return JE::Number->new(sin 9**9**9);
1291             }
1292 6         103 JE::Number->new( $global, $${$_[0]}{value} =
  6         38  
1293             _time_clip _make_date
1294             _day $v,
1295             _make_time $h, $m, $s, $ms
1296             );
1297             },
1298 2         49 }),
1299             dontenum => 1,
1300             });
1301              
1302             $proto->prop({
1303             name => 'setDate',
1304             value => JE::Object::Function->new({
1305             scope => $global,
1306             name => 'setDate',
1307             argnames => ['date'],
1308             no_proto => 1,
1309             function_args => ['this','args'],
1310             function => sub {
1311 5 100   5   34 die JE::Object::Error::TypeError->new($global,
1312             add_line_number "setDate cannot be" .
1313             " called on an object of type"
1314             . shift->class)
1315             unless $_[0]->isa('JE::Object::Date');
1316 4 100       17 my $d = defined $_[1] ? $_[1]->to_number->value
1317             : sin 9**9**9;
1318 4 100       13 if($d != $d) {
1319 1         4 $_[0]{value} = $d;
1320 1         7 return JE::Number->new($global,$d)
1321             }
1322 3         5 my $v = _gm2local $${$_[0]}{value};
  3         9  
1323 3         11 JE::Number->new( $global, $${$_[0]}{value} =
  3         19  
1324             _time_clip _local2gm _make_date
1325             _make_day(
1326             _year_from_time $v,
1327             _month_from_time $v,
1328             $d
1329             ),
1330             _time_within_day $v
1331             );
1332             },
1333 2         29 }),
1334             dontenum => 1,
1335             });
1336              
1337             $proto->prop({
1338             name => 'setUTCDate',
1339             value => JE::Object::Function->new({
1340             scope => $global,
1341             name => 'setUTCDate',
1342             argnames => ['date'],
1343             no_proto => 1,
1344             function_args => ['this','args'],
1345             function => sub {
1346 5 100   5   30 die JE::Object::Error::TypeError->new($global,
1347             add_line_number "setUTCDate cannot be" .
1348             " called on an object of type"
1349             . shift->class)
1350             unless $_[0]->isa('JE::Object::Date');
1351 4 100       22 my $d = defined $_[1] ? $_[1]->to_number->value
1352             : sin 9**9**9;
1353 4 100       15 if($d != $d) {
1354 1         4 $_[0]{value} = $d;
1355 1         6 return JE::Number->new($global,$d)
1356             }
1357 3         6 my $v = $${$_[0]}{value};
  3         9  
1358 3         11 JE::Number->new( $global, $${$_[0]}{value} =
  3         17  
1359             _time_clip _make_date
1360             _make_day(
1361             _year_from_time $v,
1362             _month_from_time $v,
1363             $d
1364             ),
1365             _time_within_day $v
1366             );
1367             },
1368 2         24 }),
1369             dontenum => 1,
1370             });
1371              
1372             $proto->prop({
1373             name => 'setMonth',
1374             value => JE::Object::Function->new({
1375             scope => $global,
1376             name => 'setMonth',
1377             argnames => ['month','date'],
1378             no_proto => 1,
1379             function_args => ['this','args'],
1380             function => sub {
1381 17 100   17   110 die JE::Object::Error::TypeError->new($global,
1382             add_line_number "setMonth cannot be" .
1383             " called on an object of type"
1384             . shift->class)
1385             unless $_[0]->isa('JE::Object::Date');
1386 16 100       90 my $m = defined $_[1] ? $_[1]->to_number->value
1387             : sin 9**9**9;
1388 16 100       60 if($m != $m) {
1389 1         4 $_[0]{value} = sin 9**9**9;
1390 1         5 return JE::Number->new($global,sin 9**9**9)
1391             }
1392 15         26 my $v = _gm2local $${$_[0]}{value};
  15         58  
1393 15 100       90 my $d =
1394             defined $_[2]
1395             ? $_[2]->to_number->value
1396             : _date_from_time $v;
1397 15         58 JE::Number->new( $global, $${$_[0]}{value} =
  15         105  
1398             _time_clip _local2gm _make_date
1399             _make_day(
1400             _year_from_time $v,
1401             $m,
1402             $d
1403             ),
1404             _time_within_day $v
1405             );
1406             },
1407 2         28 }),
1408             dontenum => 1,
1409             });
1410              
1411             $proto->prop({
1412             name => 'setUTCMonth',
1413             value => JE::Object::Function->new({
1414             scope => $global,
1415             name => 'setUTCMonth',
1416             argnames => ['month','date'],
1417             no_proto => 1,
1418             function_args => ['this','args'],
1419             function => sub {
1420 17 100   17   103 die JE::Object::Error::TypeError->new($global,
1421             add_line_number "setUTCMonth cannot be" .
1422             " called on an object of type"
1423             . shift->class)
1424             unless $_[0]->isa('JE::Object::Date');
1425 16 100       86 my $m = defined $_[1] ? $_[1]->to_number->value
1426             : sin 9**9**9;
1427 16 100       64 if($m != $m) {
1428 1         5 $_[0]{value} = sin 9**9**9;
1429 1         6 return JE::Number->new($global,sin 9**9**9)
1430             }
1431 15         24 my $v = $${$_[0]}{value};
  15         57  
1432 15 100       67 my $d =
1433             defined $_[2]
1434             ? $_[2]->to_number->value
1435             : _date_from_time $v;
1436 15         43 JE::Number->new( $global, $${$_[0]}{value} =
  15         103  
1437             _time_clip _make_date
1438             _make_day(
1439             _year_from_time $v,
1440             $m,
1441             $d
1442             ),
1443             _time_within_day $v
1444             );
1445             },
1446 2         24 }),
1447             dontenum => 1,
1448             });
1449              
1450             $proto->prop({
1451             name => 'setYear',
1452             value => JE::Object::Function->new({
1453             scope => $global,
1454             name => 'setMilliseconds',
1455             argnames => ['ms'],
1456             no_proto => 1,
1457             function_args => ['this','args'],
1458             function => sub {
1459 0 0   0   0 die JE::Object::Error::TypeError->new($global,
1460             add_line_number "setYear cannot be" .
1461             " called on an object of type"
1462             . shift->class)
1463             unless $_[0]->isa('JE::Object::Date');
1464 0 0       0 my $y = defined $_[1] ? $_[1]->to_number->value
1465             : sin 9**9**9;
1466 0 0       0 if($y != $y) {
1467 0         0 $_[0]{value} = $y; return JE::Number->new($y)
  0         0  
1468             }
1469 0         0 my $inty = int $y;
1470 0 0 0     0 $inty >= 0 && $inty <= 99 and $y = $inty+1900;
1471 0         0 my $v = _gm2local $${$_[0]}{value};
  0         0  
1472 0 0       0 $v == $v or $v = 0;
1473 0         0 JE::Number->new( $global, $${$_[0]}{value} =
  0         0  
1474             _time_clip _local2gm _make_date
1475             _make_day(
1476             $y,
1477             _month_from_time $v,
1478             _date_from_time $v
1479             ),
1480             _time_within_day $v
1481             );
1482             },
1483 2         26 }),
1484             dontenum => 1,
1485             });
1486              
1487             $proto->prop({
1488             name => 'setFullYear',
1489             value => JE::Object::Function->new({
1490             scope => $global,
1491             name => 'setFullYear',
1492             argnames => ['year','month','date'],
1493             no_proto => 1,
1494             function_args => ['this','args'],
1495             function => sub {
1496 18 100   18   108 die JE::Object::Error::TypeError->new($global,
1497             add_line_number "setFullYear cannot be" .
1498             " called on an object of type"
1499             . shift->class)
1500             unless $_[0]->isa('JE::Object::Date');
1501 17 100       77 my $y = defined $_[1] ? $_[1]->to_number->value
1502             : sin 9**9**9;
1503 17 100       57 if($y != $y) {
1504 1         5 $_[0]{value} = sin 9**9**9;
1505 1         7 return JE::Number->new($global,sin 9**9**9)
1506             }
1507 16         27 my $v = _gm2local $${$_[0]}{value};
  16         59  
1508 16 100       110 my $m =
1509             defined $_[2]
1510             ? $_[2]->to_number->value
1511             : _month_from_time $v;
1512 16 100       75 my $d =
1513             defined $_[3]
1514             ? $_[3]->to_number->value
1515             : _date_from_time $v;
1516 16         60 JE::Number->new( $global, $${$_[0]}{value} =
  16         116  
1517             _time_clip _local2gm _make_date
1518             _make_day(
1519             $y,
1520             $m,
1521             $d
1522             ),
1523             _time_within_day $v
1524             );
1525             },
1526 2         28 }),
1527             dontenum => 1,
1528             });
1529              
1530             $proto->prop({
1531             name => 'setUTCFullYear',
1532             value => JE::Object::Function->new({
1533             scope => $global,
1534             name => 'setUTCFullYear',
1535             argnames => ['year','month','date'],
1536             no_proto => 1,
1537             function_args => ['this','args'],
1538             function => sub {
1539 18 100   18   99 die JE::Object::Error::TypeError->new($global,
1540             add_line_number "setUTCFullYear cannot be" .
1541             " called on an object of type"
1542             . shift->class)
1543             unless $_[0]->isa('JE::Object::Date');
1544 17 100       77 my $y = defined $_[1] ? $_[1]->to_number->value
1545             : sin 9**9**9;
1546 17 100       57 if($y != $y) {
1547 1         4 $_[0]{value} = sin 9**9**9;
1548 1         6 return JE::Number->new($global,sin 9**9**9)
1549             }
1550 16         27 my $v = $${$_[0]}{value};
  16         58  
1551 16 100       71 my $m =
1552             defined $_[2]
1553             ? $_[2]->to_number->value
1554             : _month_from_time $v;
1555 16 100       73 my $d =
1556             defined $_[3]
1557             ? $_[3]->to_number->value
1558             : _date_from_time $v;
1559 16         61 JE::Number->new( $global, $${$_[0]}{value} =
  16         94  
1560             _time_clip _make_date
1561             _make_day(
1562             $y,
1563             $m,
1564             $d
1565             ),
1566             _time_within_day $v
1567             );
1568             },
1569 2         42 }),
1570             dontenum => 1,
1571             });
1572              
1573             my $tgs = $proto->prop({
1574             name => 'toGMTString',
1575             value => JE::Object::Function->new({
1576             scope => $global,
1577             name => 'toGMTString',
1578             no_proto => 1,
1579             function_args => ['this'],
1580             function => sub {
1581 0 0   0   0 die JE::Object::Error::TypeError->new($global,
1582             add_line_number "toGMTString cannot be" .
1583             " called on an object of type"
1584             . shift->class)
1585             unless $_[0]->isa('JE::Object::Date');
1586 0         0 my $v = $${+shift}{value};
  0         0  
1587 0         0 JE::String->_new( $global,
1588             sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT",
1589             $days[_week_day $v], _date_from_time $v,
1590             $mon[_month_from_time $v],
1591             _year_from_time $v, _hours_from_time $v,
1592             _min_from_time $v, _sec_from_time $v
1593             );
1594             },
1595 2         21 }),
1596             dontenum => 1,
1597             });
1598 2         11 $proto->prop(
1599             {name => toUTCString => value => $tgs => dontenum => 1}
1600             );
1601              
1602 2         7 weaken $global;
1603 2         27 $f;
1604             }
1605              
1606              
1607              
1608             return "a true value";