File Coverage

blib/lib/No/Worries/Date.pm
Criterion Covered Total %
statement 64 65 98.4
branch 17 18 94.4
condition n/a
subroutine 16 16 100.0
pod 3 3 100.0
total 100 102 98.0


line stmt bran cond sub pod time code
1             #+##############################################################################
2             # #
3             # File: No/Worries/Date.pm #
4             # #
5             # Description: date handling without worries #
6             # #
7             #-##############################################################################
8              
9             #
10             # module definition
11             #
12              
13             package No::Worries::Date;
14 3     3   76667 use strict;
  3         17  
  3         92  
15 3     3   17 use warnings;
  3         6  
  3         69  
16 3     3   102 use 5.005; # need the four-argument form of substr()
  3         11  
17             our $VERSION = "1.7";
18             our $REVISION = sprintf("%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/);
19              
20             #
21             # used modules
22             #
23              
24 3     3   1619 use HTTP::Date qw(str2time);
  3         14379  
  3         231  
25 3     3   889 use No::Worries::Die qw(dief);
  3         9  
  3         18  
26 3     3   28 use No::Worries::Export qw(export_control);
  3         28  
  3         17  
27 3     3   21 use Params::Validate qw(validate_pos :types);
  3         5  
  3         483  
28 3     3   1574 use POSIX qw(strftime);
  3         20667  
  3         17  
29              
30             #
31             # constants
32             #
33              
34 3     3   4388 use constant STRFTIME_STRING_FORMAT => "%Y-%m-%dT%H:%M:%SZ";
  3         30  
  3         254  
35 3     3   23 use constant STRFTIME_STAMP_FORMAT => "%Y/%m/%d-%H:%M:%S";
  3         6  
  3         294  
36              
37             #
38             # handle the given time that could be undef or '1.433330218094E9'
39             #
40              
41             sub _time ($) {
42 20     20   40 my($time) = @_;
43              
44 20 100       47 return(time(), 0) unless defined($time);
45 18         29 eval {
46 3     3   21 use warnings FATAL => qw(numeric);
  3         5  
  3         1928  
47 18         67 $time += 0;
48             };
49 18 100       46 dief("invalid time: %s", $time) if $@;
50 16 100       172 if ($time =~ /^(\d+)$/) {
    50          
51 10         40 return($1, 0);
52             } elsif ($time =~ /^(\d+)\.(\d+)$/) {
53 6         29 return($1, $2);
54             } else {
55 0         0 dief("invalid time: %s", $time);
56             }
57             }
58              
59             #
60             # convert a string to a time
61             #
62              
63             sub date_parse ($) {
64 14     14 1 8115 my($string) = @_;
65 14         22 my($time);
66              
67 14         179 validate_pos(@_, { type => SCALAR });
68 14         57 $time = str2time($string);
69 14 100       1571 dief("invalid date: %s", $string) unless defined($time);
70 13         36 return($time);
71             }
72              
73             #
74             # convert a time to human friendly string (local time)
75             #
76              
77             sub date_stamp (;$) {
78 10     10 1 3404 my($time) = @_;
79 10         17 my($int, $frac, $string);
80              
81 10 100       124 validate_pos(@_, { type => SCALAR }) if @_;
82 10         32 ($int, $frac) = _time($time);
83 9         420 $string = strftime(STRFTIME_STAMP_FORMAT, localtime($int));
84 9 100       53 $string .= ".$frac" if $frac;
85 9         39 return($string);
86             }
87              
88             #
89             # convert a time to an ISO 8601 compliant string (UTC based)
90             #
91              
92             sub date_string (;$) {
93 10     10 1 710 my($time) = @_;
94 10         18 my($int, $frac, $string);
95              
96 10 100       136 validate_pos(@_, { type => SCALAR }) if @_;
97 10         35 ($int, $frac) = _time($time);
98 9         437 $string = strftime(STRFTIME_STRING_FORMAT, gmtime($int));
99 9 100       54 substr($string, -1, 0, ".$frac") if $frac;
100 9         40 return($string);
101             }
102              
103             #
104             # export control
105             #
106              
107             sub import : method {
108 3     3   16 my($pkg, %exported);
109              
110 3         8 $pkg = shift(@_);
111 3         22 grep($exported{$_}++, map("date_$_", qw(parse stamp string)));
112 3         19 export_control(scalar(caller()), $pkg, \%exported, @_);
113             }
114              
115             1;
116              
117             __DATA__