File Coverage

blib/lib/App/WRT/Date.pm
Criterion Covered Total %
statement 32 33 96.9
branch 3 4 75.0
condition n/a
subroutine 9 9 100.0
pod 5 5 100.0
total 49 51 96.0


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;