1#+############################################################################## 2# # 3# File: No/Worries/Date.pm # 4# # 5# Description: date handling without worries # 6# # 7#-############################################################################## 8 9# 10# module definition 11# 12 13package No::Worries::Date; 14use strict; 15use warnings; 16use 5.005; # need the four-argument form of substr() 17our $VERSION = "1.6"; 18our $REVISION = sprintf("%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/); 19 20# 21# used modules 22# 23 24use HTTP::Date qw(str2time); 25use No::Worries::Die qw(dief); 26use No::Worries::Export qw(export_control); 27use Params::Validate qw(validate_pos :types); 28use POSIX qw(strftime); 29 30# 31# constants 32# 33 34use constant STRFTIME_STRING_FORMAT => "%Y-%m-%dT%H:%M:%SZ"; 35use constant STRFTIME_STAMP_FORMAT => "%Y/%m/%d-%H:%M:%S"; 36 37# 38# handle the given time that could be undef or '1.433330218094E9' 39# 40 41sub _time ($) { 42 my($time) = @_; 43 44 return(time(), 0) unless defined($time); 45 eval { 46 use warnings FATAL => qw(numeric); 47 $time += 0; 48 }; 49 dief("invalid time: %s", $time) if $@; 50 if ($time =~ /^(\d+)$/) { 51 return($1, 0); 52 } elsif ($time =~ /^(\d+)\.(\d+)$/) { 53 return($1, $2); 54 } else { 55 dief("invalid time: %s", $time); 56 } 57} 58 59# 60# convert a string to a time 61# 62 63sub date_parse ($) { 64 my($string) = @_; 65 my($time); 66 67 validate_pos(@_, { type => SCALAR }); 68 $time = str2time($string); 69 dief("invalid date: %s", $string) unless defined($time); 70 return($time); 71} 72 73# 74# convert a time to human friendly string (local time) 75# 76 77sub date_stamp (;$) { 78 my($time) = @_; 79 my($int, $frac, $string); 80 81 validate_pos(@_, { type => SCALAR }) if @_; 82 ($int, $frac) = _time($time); 83 $string = strftime(STRFTIME_STAMP_FORMAT, localtime($int)); 84 $string .= ".$frac" if $frac; 85 return($string); 86} 87 88# 89# convert a time to an ISO 8601 compliant string (UTC based) 90# 91 92sub date_string (;$) { 93 my($time) = @_; 94 my($int, $frac, $string); 95 96 validate_pos(@_, { type => SCALAR }) if @_; 97 ($int, $frac) = _time($time); 98 $string = strftime(STRFTIME_STRING_FORMAT, gmtime($int)); 99 substr($string, -1, 0, ".$frac") if $frac; 100 return($string); 101} 102 103# 104# export control 105# 106 107sub import : method { 108 my($pkg, %exported); 109 110 $pkg = shift(@_); 111 grep($exported{$_}++, map("date_$_", qw(parse stamp string))); 112 export_control(scalar(caller()), $pkg, \%exported, @_); 113} 114 1151; 116 117__DATA__ 118 119=head1 NAME 120 121No::Worries::Date - date handling without worries 122 123=head1 SYNOPSIS 124 125 use No::Worries::Date qw(date_parse date_stamp date_string); 126 127 $string = date_stamp(); 128 # e.g. 2012/04/12-11:01:42 129 130 $string = date_string(time()); 131 # e.g. 2012-04-12T09:01:42Z 132 133 $string = date_string(Time::HiRes::time()); 134 # e.g. 2012-04-12T09:01:42.48602Z 135 136 $time = date_parse("Sun, 06 Nov 1994 08:49:37 GMT"); 137 138=head1 DESCRIPTION 139 140This module eases date handling by providing convenient wrappers 141around standard date functions. All the functions die() on error. 142 143The strings and times may include fractional seconds like in the 144example above. 145 146date_parse() can accept many more formats than simply what 147date_stamp() and date_string() return. 148 149=head1 FUNCTIONS 150 151This module provides the following functions (none of them being 152exported by default): 153 154=over 155 156=item date_parse(STRING) 157 158parse the given string and return the corresponding numerical time 159(i.e. the number of non-leap seconds since the epoch) or an error; 160L<HTTP::Date>'s str2time() is used for the parsing 161 162=item date_stamp([TIME]) 163 164convert the given numerical time (or the current time if not given) to 165a human friendly, compact, local time string 166 167=item date_string([TIME]) 168 169convert the given numerical time (or the current time if not given) to 170a standard, ISO 8601 compliant, UTC based string 171 172=back 173 174=head1 SEE ALSO 175 176L<HTTP::Date>, 177L<No::Worries>. 178 179=head1 AUTHOR 180 181Lionel Cons L<http://cern.ch/lionel.cons> 182 183Copyright (C) CERN 2012-2019 184