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

#+##############################################################################
#                                                                              #
# File: No/Worries/Date.pm                                                     #
#                                                                              #
# Description: date handling without worries                                   #
#                                                                              #
#-##############################################################################

#
# module definition
#

package No::Worries::Date;
use strict;
use warnings;
use 5.005; # need the four-argument form of substr()
our $VERSION  = "1.5";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/);

#
# used modules
#

use HTTP::Date qw(str2time);
use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);
use Params::Validate qw(validate_pos :types);
use POSIX qw(strftime);

#
# constants
#

use constant STRFTIME_STRING_FORMAT => "%Y-%m-%dT%H:%M:%SZ";
use constant STRFTIME_STAMP_FORMAT  => "%Y/%m/%d-%H:%M:%S";

#
# handle the given time that could be undef or '1.433330218094E9'
#

sub _time ($) {
    my($time) = @_;

    return(time(), 0) unless defined($time);
    eval {
        use warnings FATAL => qw(numeric);
        $time += 0;
    };
    dief("invalid time: %s", $time) if $@;
    if ($time =~ /^(\d+)$/) {
        return($1, 0);
    } elsif ($time =~ /^(\d+)\.(\d+)$/) {
        return($1, $2);
    } else {
        dief("invalid time: %s", $time);
    }
}

#
# convert a string to a time
#

sub date_parse ($) {
    my($string) = @_;
    my($time);

    validate_pos(@_, { type => SCALAR });
    $time = str2time($string);
    dief("invalid date: %s", $string) unless defined($time);
    return($time);
}

#
# convert a time to human friendly string (local time)
#

sub date_stamp (;$) {
    my($time) = @_;
    my($int, $frac, $string);

    validate_pos(@_, { type => SCALAR }) if @_;
    ($int, $frac) = _time($time);
    $string = strftime(STRFTIME_STAMP_FORMAT, localtime($int));
    $string .= ".$frac" if $frac;
    return($string);
}

#
# convert a time to an ISO 8601 compliant string (UTC based)
#

sub date_string (;$) {
    my($time) = @_;
    my($int, $frac, $string);

    validate_pos(@_, { type => SCALAR }) if @_;
    ($int, $frac) = _time($time);
    $string = strftime(STRFTIME_STRING_FORMAT, gmtime($int));
    substr($string, -1, 0, ".$frac") if $frac;
    return($string);
}

#
# export control
#

sub import : method {
    my($pkg, %exported);

    $pkg = shift(@_);
    grep($exported{$_}++, map("date_$_", qw(parse stamp string)));
    export_control(scalar(caller()), $pkg, \%exported, @_);
}

1;

__DATA__