| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package App::WRT::Date; |
|
2
|
|
|
|
|
|
|
|
|
3
|
9
|
|
|
9
|
|
684
|
use strict; |
|
|
9
|
|
|
|
|
17
|
|
|
|
9
|
|
|
|
|
250
|
|
|
4
|
9
|
|
|
9
|
|
41
|
use warnings; |
|
|
9
|
|
|
|
|
15
|
|
|
|
9
|
|
|
|
|
270
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
9
|
|
|
9
|
|
48
|
use base qw(Exporter); |
|
|
9
|
|
|
|
|
17
|
|
|
|
9
|
|
|
|
|
1014
|
|
|
7
|
|
|
|
|
|
|
our @EXPORT_OK = qw(iso_date rfc_3339_date get_date get_mtime month_name); |
|
8
|
|
|
|
|
|
|
|
|
9
|
9
|
|
|
9
|
|
57
|
use POSIX qw(strftime); |
|
|
9
|
|
|
|
|
15
|
|
|
|
9
|
|
|
|
|
69
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
App::WRT::Date - a small collection of date utility functions |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head2 FUNCTIONS |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=over |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=item rfc_3339_date($time) |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Return an RFC 3339 date string for the given epoch time. |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
L |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub rfc_3339_date { |
|
28
|
7
|
|
|
7
|
1
|
1375
|
my ($time) = @_; |
|
29
|
7
|
|
|
|
|
324
|
my $time_str = strftime('%Y-%m-%dT%H:%M:%S%z', localtime($time)); |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# HACK: Add a : to the last 4 digits, because apparently this isn't supported |
|
32
|
|
|
|
|
|
|
# by POSIX strftime(). |
|
33
|
7
|
|
|
|
|
85
|
$time_str =~ s/(\d{2})(\d{2})$/$1:$2/x; |
|
34
|
7
|
|
|
|
|
35
|
return $time_str; |
|
35
|
|
|
|
|
|
|
} |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=item iso_date($time) |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Return an ISO 8601 date string for the given epoch time. |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=cut |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub iso_date { |
|
44
|
17
|
|
|
17
|
1
|
29
|
my ($time) = @_; |
|
45
|
17
|
|
|
|
|
1284
|
return strftime("%Y-%m-%dT%H:%M:%SZ", localtime($time)); |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=item get_mtime(@filenames) |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Return one or more mtimes for a given list of files. |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub get_mtime { |
|
55
|
23
|
|
|
23
|
1
|
617
|
my (@filenames) = @_; |
|
56
|
|
|
|
|
|
|
|
|
57
|
23
|
|
|
|
|
41
|
my @mtimes; |
|
58
|
23
|
|
|
|
|
34
|
for my $filename (@filenames) { |
|
59
|
|
|
|
|
|
|
#my( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, |
|
60
|
|
|
|
|
|
|
# $atime, $mtime, $ctime, $blksize, $blocks ) |
|
61
|
|
|
|
|
|
|
# = stat( $filename ); |
|
62
|
|
|
|
|
|
|
|
|
63
|
23
|
|
|
|
|
483
|
push @mtimes, (stat $filename)[9]; |
|
64
|
|
|
|
|
|
|
} |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# return a list if we've got more than one, a scalar |
|
67
|
|
|
|
|
|
|
# otherwise. is this evil? or even necessary? |
|
68
|
23
|
50
|
|
|
|
83
|
if (@mtimes > 1) { |
|
69
|
0
|
|
|
|
|
0
|
return @mtimes; |
|
70
|
|
|
|
|
|
|
} else { |
|
71
|
23
|
|
|
|
|
126
|
return $mtimes[0]; |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item month_name($number) |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Turn numeric months into English names. |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
{ |
|
82
|
|
|
|
|
|
|
# "Null" is here so that $month_name[1] corresponds to January, etc. |
|
83
|
|
|
|
|
|
|
my @months = qw(Null January February March April May June |
|
84
|
|
|
|
|
|
|
July August September October November December); |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub month_name { |
|
87
|
41
|
|
|
41
|
1
|
1144
|
my ($number) = @_; |
|
88
|
41
|
|
|
|
|
143
|
return $months[$number]; |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item get_date('key', 'other_key', ...) |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Return current date values for the given key. Valid keys are sec, min, hour, |
|
95
|
|
|
|
|
|
|
mday (day of month), mon, year, wday (day of week), yday (day of year), and |
|
96
|
|
|
|
|
|
|
isdst (is daylight savings). |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Remember that year is given in years after 1900. |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=cut |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Below replaces: |
|
103
|
|
|
|
|
|
|
# my ($sec, $min, $hour, $mday, $mon, |
|
104
|
|
|
|
|
|
|
# $year, $wday, $yday, $isdst) = localtime(time); |
|
105
|
|
|
|
|
|
|
{ |
|
106
|
|
|
|
|
|
|
my %name_map = ( |
|
107
|
|
|
|
|
|
|
sec => 0, min => 1, hour => 2, mday => 3, |
|
108
|
|
|
|
|
|
|
mon => 4, year => 5, wday => 6, yday => 5, |
|
109
|
|
|
|
|
|
|
isdst => 6, |
|
110
|
|
|
|
|
|
|
); |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub get_date { |
|
113
|
2
|
|
|
2
|
1
|
331
|
my (@names) = @_; |
|
114
|
2
|
|
|
|
|
5
|
my (@indices) = @name_map{@names}; |
|
115
|
2
|
|
|
|
|
60
|
my (@values) = (localtime time)[@indices]; |
|
116
|
|
|
|
|
|
|
|
|
117
|
2
|
100
|
|
|
|
22
|
if (wantarray()) { |
|
118
|
|
|
|
|
|
|
# my ($foo, $bar) = get_date('foo', 'bar'); |
|
119
|
1
|
|
|
|
|
5
|
return @values; |
|
120
|
|
|
|
|
|
|
} else { |
|
121
|
|
|
|
|
|
|
# this is probably useless unless you're getting just one value |
|
122
|
1
|
|
|
|
|
15
|
return join '', @values; |
|
123
|
|
|
|
|
|
|
} |
|
124
|
|
|
|
|
|
|
} |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=back |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
1; |