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 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;