/
Temporal.pm
181 lines (150 loc) · 6.1 KB
/
Temporal.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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
# Not Yet Implemented
#enum dayOfWeek <Sunday Monday Tuesday Wednesday Thursday Friday Saturday>;
#enum DayOfWeek <Sunday Monday Tuesday Wednesday Thursday Friday Saturday>;
my subset Month of Int where { 1 <= $^a <= 12 };
my subset Day of Int where { 1 <= $^a <= 31 };
my subset DayOfWeek of Int where { 1 <= $^a <= 7 };
my subset Hour of Int where { 0 <= $^a <= 23 };
my subset Minute of Int where { 0 <= $^a <= 59 };
my subset Second of Num where { 0 <= $^a <= 60 };
role Temporal::Date {
has Int $.year;
has Month $.month = 1;
has Day $.day = 1;
method day-of-week { # returns DayOfWeek {
my ( $a, $y, $m, $jd ); # algorithm from Claus Tøndering
$a = int((14 - $.month) / 12 );
$y = $.year + 4800 - $a;
$m = $.month + 12 * $a - 3;
$jd = $.day + int((153 * $m + 2) / 5) + 365 * $y + int( $y / 4 )
- int( $y / 100 ) + int( $y / 400 ) - 32045;
return ($jd + 1) % 7 + 1;
}
our Str method month-name {
return <January February March April May June July August
September October November December>[$.month-1];
}
our Str method day-name {
return <Sunday Monday Tuesday Wednesday Thursday Friday
Saturday>[self.day-of-week-1];
}
our Str method iso8601 {
given self {
return sprintf '%04d-%02d-%02d', .year, .month, .day;
}
}
method Str { self.iso8601 };
sub infix:{'<=>'}( Temporal::Date $left, Temporal::Date $right )
is export # would like to define it with «<=>»
{
$left.year <=> $right.year
||
$left.month <=> $right.month
||
$left.day <=> $right.day;
}
}
role Temporal::Time {
has Hour $.hour = 0;
has Minute $.minute = 0;
has Second $.second = 0;
our Str method iso8601 {
given self {
return sprintf '%02d:%02d:%02d', .hour, .minute, .second;
}
}
method Str { self.iso8601; }
sub infix:{'<=>'}( Temporal::Time $left, Temporal::Time $right )
is export # would like to define it with «<=>»
{
$left.hour <=> $right.hour
||
$left.minute <=> $right.minute
||
$left.second <=> $right.second;
}
}
role Temporal::TimeZone::Observance {
my subset Offset of Int where { -86400 < $^a < 86400 };
has Offset $.offset;
has Bool $.isdst;
has Str $.abbreviation; # UTC, CST, AST
# The ISO8601 standard does not allow for offsets with sub-minute
# resolutions. In real-world practice, this is not an issue.
our Str method iso8601 {
sprintf "%+03d%02d", self.offset / 3600,
int( abs(self.offset) / 60 ) % 60;
}
method Str { self.iso8601 }
}
role Temporal::DateTime {
has Temporal::Date $.date;
has Temporal::Time $.time;
has Temporal::TimeZone::Observance $.timezone;
# TODO: replace the three above with the three below somehow fixed,
# and then revise the tests accordingly
# has Temporal::Date $!date handles <year month day day-of-week>;
# has Temporal::Time $!time handles <hour minute second fractional-second>;
# has Temporal::TimeZone::Observance $!timezone handles <offset isdst>;
our Str method iso8601 {
self.date.iso8601 ~ 'T' ~ self.time.iso8601 ~ self.timezone.iso8601;
}
method Str { self.iso8601 }
# This involves a whole bunch of code - see Perl 5's Time::Local
our Num method epoch {
my ( $a, $y, $m, $jd ); # algorithm from Claus Tøndering
$a = int((14 - $.date.month) / 12 );
$y = $.date.year + 4800 - $a;
$m = $.date.month + 12 * $a - 3;
$jd = $.date.day + int((153 * $m + 2) / 5) + 365 * $y
+ int( $y / 4 ) - int( $y / 100 ) + int( $y / 400 ) - 32045;
return $jd - 2440588
+ ($.time.hour*60 + $.time.minute)*60 + $.time.second;
}
method Int { self.epoch.truncate }
method Num { self.epoch }
}
class Time {
our method gmtime( Num $epoch = time ) {
my ( $time, $sec, $min, $hour, $mday, $mon, $year );
$time = int( $epoch );
$sec = $time % 60; $time = int($time/60);
$min = $time % 60; $time = int($time/60);
$hour = $time % 24; $time = int($time/24);
# Day month and leap year arithmetic, based on Gregorian day #.
# 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian
$time += 2440588; # because 2000-01-01 == Unix epoch day 10957
my $a = $time + 32044; # date algorithm from Claus Tøndering
my $b = int((4 * $a + 3) / 146097); # 146097 = days in 400 years
my $c = $a - int(( 146097 * $b ) / 4);
my $d = int((4 * $c + 3) / 1461); # 1461 = days in 4 years
my $e = $c - int(($d * 1461) / 4);
my $m = int((5 * $e + 2) / 153); # 153 = days in Mar-Jul Aug-Dec
$mday = $e - int((153 * $m + 2) / 5 ) + 1;
$mon = $m + 3 - 12 * int( $m / 10 );
$year = $b * 100 + $d - 4800 + int( $m / 10 );
Temporal::DateTime.new(
date => Temporal::Date.new(
year => $year, month => $mon, day => $mday ),
time => Temporal::Time.new(
hour => $hour, minute => $min, second => $sec ),
timezone => Temporal::TimeZone::Observance.new(
offset=>0, isdst=>Bool::False, abbreviation=>'UTC' )
);
}
# Not clear what spec S32-Temporal really means here...
# multi sub localtime( :$time = time(), :$tz=<GMT> ) is export { ... } # NYI
# multi sub localtime( Num $epoch = time() ) returns Temporal::DateTime { ... } # NYI
# our Num sub time() { ... } # NYI
}
=begin pod
=head1 SEE ALSO
Perl 6 spec <S32-Temporal|http://perlcabal.org/syn/S32/Temporal.html>.
Perl 5 perldoc L<doc:Time::Local>.
The best yet seen explanation of calendars, by Claus Tøndering
L<Calendar FAQ|http://www.tondering.dk/claus/calendar.html>.
Similar algorithms at L<http://www.hermetic.ch/cal_stud/jdn.htm>
and L<http://www.merlyn.demon.co.uk/daycount.htm>.
<ISO 8601|http://en.wikipedia.org/wiki/ISO_8601>
<Time zones|http://en.wikipedia.org/wiki/List_of_time_zones>
=end pod