-
-
Notifications
You must be signed in to change notification settings - Fork 373
/
Date.pm
155 lines (138 loc) · 4.39 KB
/
Date.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
class Date {
sub is-leap($year) {
return False if $year % 4;
return True if $year % 100;
$year % 400 == 0;
}
sub days-in-month($year, $month) {
my @month-length = 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31;
if ($month == 2) {
is-leap($year) ?? 29 !! 28;
} else {
@month-length[$month-1];
}
}
sub assert-valid-date($year, $month, $day) {
die 'Invalid date: day < 1' if $day < 1;
die 'Invalid date: month < 1' if $month < 1;
die 'Invalid date: month > 12' if $month > 12;
my $dim = days-in-month($year, $month);
if $day > $dim {
die "Invalid date: day > $dim";
}
}
has Int $.year;
has Int $.month;
has Int $.day;
has Int $.daycount = self!daycount-from-ymd($!year, $!month, $!day);
method !daycount-from-ymd($y is copy, $m is copy, $d) {
# taken from <http://www.merlyn.demon.co.uk/daycount.htm>
if ($m < 3) {
$m += 12;
--$y;
}
return -678973 + $d + ((153 * $m - 2) div 5)
+ 365 * $y + ($y div 4)
- ($y div 100) + ($y div 400);
}
method !ymd-from-daycount($daycount) {
# taken from <http://www.merlyn.demon.co.uk/daycount.htm>
my $y = 0;
my $m = 0;
my $d = $daycount + 678881;
my $t = ((4 * ($d + 36525)) div 146097) - 1;
$y += 100 * $t;
$d -= 36524 * $t + ($t +> 2);
$t = ((4 * ($d + 366)) div 1461) - 1;
$y += $t;
$d -= 365 * $t + ($t +> 2);
$m = (5 * $d + 2) div 153;
$d -= (2 + $m * 153) div 5;
if ($m > 9) {
$m -= 12;
$y++;
}
return $y, $m + 3, $d+1;
}
# TODO: checking for out-of-range errors
multi method new($year, $month, $day) {
assert-valid-date($year, $month, $day);
self.bless(*, :$year, :$month, :$day);
}
multi method new(:$year, :$month, :$day) {
assert-valid-date($year, $month, $day);
self.bless(*, :$year, :$month, :$day);
}
multi method new(Str $date where { $date ~~ /
^ <[0..9]>**4 '-' <[0..9]>**2 '-' <[0..9]>**2 $
/}) {
my ($year, $month, $day) = $date.split('-').map({ .Int });
assert-valid-date($year, $month, $day);
self.bless(*, :$year, :$month, :$day);
# RAKUDO: doesn't work yet - find out why
# self.new(|$date.split('-'));
}
multi method new-from-daycount($daycount) {
my ($year, $month, $day) = self!ymd-from-daycount($daycount);
self.bless(*, :$year, :$month, :$day, :$daycount);
}
multi method new(::DateTime $dt) {
self.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
}
multi method today() {
my $dt = ::DateTime.now();
self.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
}
method day-of-week() { 1 + (($!daycount + 2) % 7) }
method leap-year() { is-leap($.year) }
method days-in-month() { days-in-month($.year, $.month) }
multi method Str() {
sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
}
# arithmetics
multi method succ() {
Date.new-from-daycount($!daycount + 1);
}
multi method pred() {
Date.new-from-daycount($!daycount - 1);
}
multi method perl() {
"Date.new($.year.perl(), $.month.perl(), $.day.perl())";
}
}
multi infix:<+>(Date $d, Int $x) is export {
Date.new-from-daycount($d.daycount + $x)
}
multi infix:<+>(Int $x, Date $d) is export {
Date.new-from-daycount($d.daycount + $x)
}
multi infix:<->(Date $d, Int $x) is export {
Date.new-from-daycount($d.daycount - $x)
}
multi infix:<->(Date $a, Date $b) is export {
$a.daycount - $b.daycount;
}
multi infix:<cmp>(Date $a, Date $b) is export {
$a.daycount cmp $b.daycount
}
multi infix:«<=>»(Date $a, Date $b) is export {
$a.daycount <=> $b.daycount
}
multi infix:<==>(Date $a, Date $b) is export {
$a.daycount == $b.daycount
}
multi infix:<!=>(Date $a, Date $b) is export {
$a.daycount != $b.daycount
}
multi infix:«<=»(Date $a, Date $b) is export {
$a.daycount <= $b.daycount
}
multi infix:«<»(Date $a, Date $b) is export {
$a.daycount < $b.daycount
}
multi infix:«>=»(Date $a, Date $b) is export {
$a.daycount >= $b.daycount
}
multi infix:«>»(Date $a, Date $b) is export {
$a.daycount > $b.daycount
}