line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::WRT::Date; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
645
|
use strict; |
|
10
|
|
|
|
|
23
|
|
|
10
|
|
|
|
|
323
|
|
4
|
10
|
|
|
10
|
|
55
|
use warnings; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
308
|
|
5
|
|
|
|
|
|
|
|
6
|
10
|
|
|
10
|
|
64
|
use base qw(Exporter); |
|
10
|
|
|
|
|
16
|
|
|
10
|
|
|
|
|
1111
|
|
7
|
|
|
|
|
|
|
our @EXPORT_OK = qw(iso_date rfc_3339_date get_date get_mtime month_name); |
8
|
|
|
|
|
|
|
|
9
|
10
|
|
|
10
|
|
66
|
use POSIX qw(strftime); |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
85
|
|
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
|
1681
|
my ($time) = @_; |
29
|
7
|
|
|
|
|
360
|
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
|
|
|
|
|
86
|
$time_str =~ s/(\d{2})(\d{2})$/$1:$2/x; |
34
|
7
|
|
|
|
|
41
|
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
|
40
|
my ($time) = @_; |
45
|
17
|
|
|
|
|
1200
|
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
|
1020
|
my (@filenames) = @_; |
56
|
|
|
|
|
|
|
|
57
|
23
|
|
|
|
|
32
|
my @mtimes; |
58
|
23
|
|
|
|
|
43
|
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
|
|
|
|
|
513
|
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
|
|
|
|
93
|
if (@mtimes > 1) { |
69
|
0
|
|
|
|
|
0
|
return @mtimes; |
70
|
|
|
|
|
|
|
} else { |
71
|
23
|
|
|
|
|
136
|
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
|
1369
|
my ($number) = @_; |
88
|
41
|
|
|
|
|
127
|
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
|
429
|
my (@names) = @_; |
114
|
2
|
|
|
|
|
6
|
my (@indices) = @name_map{@names}; |
115
|
2
|
|
|
|
|
46
|
my (@values) = (localtime time)[@indices]; |
116
|
|
|
|
|
|
|
|
117
|
2
|
100
|
|
|
|
23
|
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
|
|
|
|
|
16
|
return join '', @values; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=back |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
1; |