line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package perl5i::2::DateTime; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# A file to contain the Datetime work for perl5i to get it out of perl5i.pm |
4
|
|
|
|
|
|
|
|
5
|
101
|
|
|
101
|
|
2343
|
use 5.010; |
|
101
|
|
|
|
|
623
|
|
|
101
|
|
|
|
|
3857
|
|
6
|
101
|
|
|
101
|
|
531
|
use strict; |
|
101
|
|
|
|
|
403
|
|
|
101
|
|
|
|
|
3411
|
|
7
|
101
|
|
|
101
|
|
799
|
use warnings; |
|
101
|
|
|
|
|
179
|
|
|
101
|
|
|
|
|
5828
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Determine if we need Time::y2038 and only load if necessary. |
10
|
|
|
|
|
|
|
# XXX This is a bit of a hack and should go into a config file. |
11
|
101
|
|
33
|
|
|
13948
|
use constant NEEDS_y2038 => ( |
12
|
|
|
|
|
|
|
((((CORE::gmtime(2**47-1))[5] || 0) + 1900) != 4461763) || |
13
|
|
|
|
|
|
|
((((CORE::gmtime(-62135510400))[5] || 0) + 1900) != 1) |
14
|
101
|
|
|
101
|
|
457
|
); |
|
101
|
|
|
|
|
213
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
BEGIN { |
17
|
101
|
|
|
101
|
|
47318
|
if( NEEDS_y2038 ) { |
18
|
|
|
|
|
|
|
require Time::y2038; |
19
|
|
|
|
|
|
|
Time::y2038->import; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
## no critic (Subroutines::ProhibitSubroutinePrototypes) |
24
|
|
|
|
|
|
|
sub dt_gmtime (;$) { |
25
|
1
|
50
|
|
1
|
0
|
8
|
my $time = @_ ? shift : time; |
26
|
1
|
50
|
|
|
|
4
|
return gmtime($time) if wantarray; |
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
|
|
7
|
my($sec, $min, $hour, $mday, $mon, $year) = gmtime($time); |
29
|
1
|
|
|
|
|
2
|
$mon++; |
30
|
1
|
|
|
|
|
2
|
$year += 1900; |
31
|
|
|
|
|
|
|
|
32
|
1
|
|
|
|
|
171
|
require DateTime; |
33
|
0
|
|
|
|
|
0
|
return perl5i::2::DateTime::y2038->new( |
34
|
|
|
|
|
|
|
year => $year, |
35
|
|
|
|
|
|
|
month => $mon, |
36
|
|
|
|
|
|
|
day => $mday, |
37
|
|
|
|
|
|
|
hour => $hour, |
38
|
|
|
|
|
|
|
minute => $min, |
39
|
|
|
|
|
|
|
second => $sec, |
40
|
|
|
|
|
|
|
formatter => "perl5i::2::DateTime::Format::CTime" |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub _get_datetime_timezone { |
46
|
2
|
|
|
2
|
|
6
|
state $local_tzfile = "/etc/localtime"; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Always be sure to honor the TZ environment var |
49
|
2
|
50
|
|
|
|
12
|
return "local" if $ENV{TZ}; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Work around a bug in DateTime::TimeZone on FreeBSD where it |
52
|
|
|
|
|
|
|
# can't determine the time zone if /etc/localtime is not a link. |
53
|
|
|
|
|
|
|
# Tzfile is also faster to do localtime calculations. |
54
|
2
|
50
|
|
|
|
36
|
if( -e $local_tzfile ) { |
55
|
|
|
|
|
|
|
# Could go through more effort to figure it out. Meh. |
56
|
2
|
|
|
|
|
5
|
my $tzname = "Local"; |
57
|
2
|
50
|
|
|
|
26
|
if( -l $local_tzfile ) { |
58
|
0
|
0
|
|
|
|
0
|
if( my $real_tzfile = eval { readlink $local_tzfile } ) { |
|
0
|
|
|
|
|
0
|
|
59
|
0
|
|
|
|
|
0
|
$tzname = $real_tzfile; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} |
62
|
2
|
|
|
|
|
1281
|
require DateTime::TimeZone::Tzfile; |
63
|
2
|
|
|
|
|
18579
|
my $tz = DateTime::TimeZone::Tzfile->new( |
64
|
|
|
|
|
|
|
name => $tzname, |
65
|
|
|
|
|
|
|
filename => $local_tzfile |
66
|
|
|
|
|
|
|
); |
67
|
2
|
50
|
|
|
|
10076
|
return $tz if $tz; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
0
|
return "local"; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
## no critic (Subroutines::ProhibitSubroutinePrototypes) |
74
|
|
|
|
|
|
|
sub dt_localtime (;$) { |
75
|
2
|
100
|
|
2
|
0
|
231
|
my $time = @_ ? shift : time; |
76
|
2
|
50
|
|
|
|
10
|
return localtime($time) if wantarray; |
77
|
|
|
|
|
|
|
|
78
|
2
|
|
|
|
|
238
|
my($sec, $min, $hour, $mday, $mon, $year) = localtime($time); |
79
|
2
|
|
|
|
|
6
|
$mon++; |
80
|
2
|
|
|
|
|
8
|
$year += 1900; |
81
|
|
|
|
|
|
|
|
82
|
2
|
|
|
|
|
9
|
state $tz = _get_datetime_timezone(); |
83
|
|
|
|
|
|
|
|
84
|
2
|
|
|
|
|
504
|
require DateTime; |
85
|
0
|
|
|
|
|
0
|
return perl5i::2::DateTime::y2038->new( |
86
|
|
|
|
|
|
|
year => $year, |
87
|
|
|
|
|
|
|
month => $mon, |
88
|
|
|
|
|
|
|
day => $mday, |
89
|
|
|
|
|
|
|
hour => $hour, |
90
|
|
|
|
|
|
|
minute => $min, |
91
|
|
|
|
|
|
|
second => $sec, |
92
|
|
|
|
|
|
|
time_zone => $tz, |
93
|
|
|
|
|
|
|
formatter => "perl5i::2::DateTime::Format::CTime" |
94
|
|
|
|
|
|
|
); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
## no critic (Subroutines::ProhibitSubroutinePrototypes) |
99
|
|
|
|
|
|
|
sub dt_time () { |
100
|
1
|
|
|
1
|
0
|
3608153
|
require DateTime::Format::Epoch; |
101
|
0
|
|
|
|
|
|
state $formatter = DateTime::Format::Epoch->new( epoch => DateTime->from_epoch( epoch => 0 ) ); |
102
|
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
require DateTime; |
104
|
0
|
|
|
|
|
|
return perl5i::2::DateTime::time->from_epoch( |
105
|
|
|
|
|
|
|
epoch => time, |
106
|
|
|
|
|
|
|
formatter => $formatter |
107
|
|
|
|
|
|
|
); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
{ |
112
|
|
|
|
|
|
|
package perl5i::2::DateTime::y2038; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# Don't load DateTime until we need it. |
115
|
|
|
|
|
|
|
our @ISA = qw(DateTime); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
use overload |
118
|
|
|
|
|
|
|
"eq" => sub { |
119
|
0
|
|
|
0
|
|
0
|
my($dt1, $dt2) = @_; |
120
|
0
|
0
|
|
|
|
0
|
return "$dt1" eq "$dt2" if !eval { $dt2->isa("DateTime") }; |
|
0
|
|
|
|
|
0
|
|
121
|
0
|
|
|
|
|
0
|
return $dt1 eq $dt2; |
122
|
101
|
|
|
101
|
|
575
|
}; |
|
101
|
|
|
|
|
310
|
|
|
101
|
|
|
|
|
1167
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub say { |
125
|
0
|
|
|
0
|
|
|
CORE::say("$_[0]"); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub print { |
129
|
0
|
|
|
0
|
|
|
CORE::print("$_[0]"); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub from_epoch { |
133
|
0
|
|
|
0
|
|
|
my $class = shift; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
if( perl5i::2::DateTime::NEEDS_y2038 ) { |
136
|
101
|
|
|
101
|
|
13898
|
no warnings 'redefine'; |
|
101
|
|
|
|
|
231
|
|
|
101
|
|
|
|
|
23391
|
|
137
|
|
|
|
|
|
|
local *CORE::GLOBAL::gmtime = \&Time::y2038::gmtime; |
138
|
|
|
|
|
|
|
local *CORE::GLOBAL::localtime = \&Time::y2038::localtime; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
return $class->SUPER::from_epoch(@_); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
else { |
143
|
0
|
|
|
|
|
|
return $class->SUPER::from_epoch(@_); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Copy of DateTime's own epoch() function. |
149
|
|
|
|
|
|
|
if( perl5i::2::DateTime::NEEDS_y2038 ) { |
150
|
|
|
|
|
|
|
*epoch = sub { |
151
|
|
|
|
|
|
|
my $self = shift; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
my $zone = $self->time_zone; |
154
|
|
|
|
|
|
|
$self->set_time_zone("UTC"); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
require Time::y2038; |
157
|
|
|
|
|
|
|
my $time = Time::y2038::timegm( |
158
|
|
|
|
|
|
|
$self->sec, $self->min, $self->hour, $self->mday, |
159
|
|
|
|
|
|
|
$self->mon - 1, |
160
|
|
|
|
|
|
|
$self->year - 1900, |
161
|
|
|
|
|
|
|
); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
$self->set_time_zone($zone); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
return $time; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
{ |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
package perl5i::2::DateTime::time; |
173
|
|
|
|
|
|
|
|
174
|
101
|
|
|
101
|
|
611
|
use parent -norequire, qw(perl5i::2::DateTime::y2038); |
|
101
|
|
|
|
|
287
|
|
|
101
|
|
|
|
|
926
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
use overload |
177
|
0
|
|
|
0
|
|
0
|
"0+" => sub { $_[0]->epoch }, |
178
|
|
|
|
|
|
|
"-" => sub { |
179
|
0
|
|
|
0
|
|
0
|
my( $a, $b, $reverse ) = @_; |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
0
|
if($reverse) { |
182
|
0
|
|
|
|
|
0
|
( $b, $a ) = ( $a, $b ); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
0
|
0
|
|
|
|
0
|
my $time_a = eval { $a->isa("DateTime") } ? $a->epoch : $a; |
|
0
|
|
|
|
|
0
|
|
186
|
0
|
0
|
|
|
|
0
|
my $time_b = eval { $b->isa("DateTime") } ? $b->epoch : $b; |
|
0
|
|
|
|
|
0
|
|
187
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
0
|
return $time_a - $time_b; |
189
|
|
|
|
|
|
|
}, |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
"+" => sub { |
192
|
0
|
|
|
0
|
|
0
|
my( $a, $b, $reverse ) = @_; |
193
|
|
|
|
|
|
|
|
194
|
0
|
0
|
|
|
|
0
|
if($reverse) { |
195
|
0
|
|
|
|
|
0
|
( $b, $a ) = ( $a, $b ); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
0
|
0
|
|
|
|
0
|
my $time_a = eval { $a->isa("DateTime") } ? $a->epoch : $a; |
|
0
|
|
|
|
|
0
|
|
199
|
0
|
0
|
|
|
|
0
|
my $time_b = eval { $b->isa("DateTime") } ? $b->epoch : $b; |
|
0
|
|
|
|
|
0
|
|
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
0
|
return $time_a + $time_b; |
202
|
|
|
|
|
|
|
}, |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
"==" => sub { |
205
|
0
|
|
|
0
|
|
0
|
my($a, $b) = @_; |
206
|
0
|
0
|
|
|
|
0
|
return $a+0 == $b+0 if !eval { $b->isa("DateTime") }; |
|
0
|
|
|
|
|
0
|
|
207
|
0
|
|
|
|
|
0
|
return $a == $b; |
208
|
|
|
|
|
|
|
}, |
209
|
|
|
|
|
|
|
|
210
|
101
|
|
|
101
|
|
26050
|
fallback => 1; |
|
101
|
|
|
|
|
201
|
|
|
101
|
|
|
|
|
1218
|
|
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
{ |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
package perl5i::2::DateTime::Format::CTime; |
217
|
|
|
|
|
|
|
|
218
|
101
|
|
|
101
|
|
32850
|
use CLASS; |
|
101
|
|
|
|
|
13855
|
|
|
101
|
|
|
|
|
686
|
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub new { |
221
|
0
|
|
|
0
|
|
|
return bless {}, $CLASS; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub format_datetime { |
225
|
0
|
|
|
0
|
|
|
my $self = shift; |
226
|
0
|
|
|
|
|
|
my $dt = shift; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Straight from the Open Group asctime() docs. |
229
|
0
|
|
|
|
|
|
return sprintf "%.3s %.3s%3d %.2d:%.2d:%.2d %d", |
230
|
|
|
|
|
|
|
$dt->day_abbr, |
231
|
|
|
|
|
|
|
$dt->month_abbr, |
232
|
|
|
|
|
|
|
$dt->mday, |
233
|
|
|
|
|
|
|
$dt->hour, |
234
|
|
|
|
|
|
|
$dt->min, |
235
|
|
|
|
|
|
|
$dt->sec, |
236
|
|
|
|
|
|
|
$dt->year, |
237
|
|
|
|
|
|
|
; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
1; |