CatalystX::Usul::Time - Class methods for date and time manipulation
Index
Code Index:
Name
CatalystX::Usul::Time - Class methods for date and time manipulation
Version
Synopsis
use parent qw(CatalystX::Usul::Time);
Description
This module implements a few simple time related methods
Inherited by the base class the methods in this module are available to both
controllers and models
Subroutines/Methods
nap
$self->nap( $period );
Sleep for a given number of seconds. The sleep time can be a fraction
of a second
stamp
$iso_string = $self->stamp( $time );
Return a date time stamp in ISO format (%Y-%m-%d %H:%M). Defaults to
current time if non supplied
str2date_time
$date_time = $self->str2date_time( $dstr, $zone );
Parse a date time string and return a DateTime object. Timezone optional
str2time
$time = $self->str2date_time( $dstr, $zone );
Parse a date time string and return the number of seconds elapsed
since the epoch. This subroutine is copyright (c) 1995 Graham
Barr. All rights reserved. It has been modified to treat 9/11 as the
ninth day in November. Timezone optional
time2str
$time_string = $self->time2str( $format, $time );
Returns a formatted string representation of the given time (supplied
in seconds elapsed since the epoch)
Diagnostics
Configuration and Environment
Dependencies
Incompatibilities
There are no known incompatibilities in this module.
Bugs and Limitations
There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome
Author
Peter Flanigan, <Support at RoxSoft.co.uk>
License and Copyright
Copyright (c) 2008 Peter Flanigan. All rights reserved
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See perlartistic
This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
# @(#)$Id: Time.pm 576 2009-06-09 23:23:46Z pjf $
package CatalystX::Usul::Time;
use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 576 $ =~ /\d+/gmx );
use DateTime::Format::Epoch;
use Time::HiRes qw(usleep);
use Time::Local;
use Time::Zone;
sub nap {
my ($self, $period) = @_;
$period = $period && $period =~ m{ \A [\d._]+ \z }msx && $period > 0
? $period : 1;
return usleep( 1_000_000 * $period );
}
sub stamp {
my ($self, $time) = @_; $time = defined $time ? $time : time;
return $self->time2str( '%Y-%m-%d %H:%M', $time );
}
sub str2date_time {
my ($self, $dstr, $zone) = @_;
my $dt = DateTime->new( year => 1970, month => 1, day => 1, );
my $formatter
= DateTime::Format::Epoch->new( epoch => $dt,
unit => q(seconds),
type => q(int),
skip_leap_seconds => 1,
start_at => 0,
local_epoch => undef, );
return $formatter->parse_datetime( $self->str2time( $dstr, $zone ) );
}
sub str2time {
# This subroutine: Copyright (c) 1995 Graham Barr. All rights reserved.
# British version dd/mm/ccyy
my ($self, $dtstr, $zone) = @_;
my ($year, $month, $day, $hh, $mm, $ss, $dst, $frac, $m, $h, $result);
my %day =
( sunday => 0, monday => 1, tuesday => 2, tues => 2,
wednesday => 3, wednes => 3, thursday => 4, thur => 4,
thurs => 4, friday => 5, saturday => 6, );
my %month =
( january => 0, february => 1, march => 2, april => 3,
may => 4, june => 5, july => 6, august => 7,
september => 8, sept => 8, october => 9, november =>10,
december => 11, );
my @suf = (qw(th st nd rd th th th th th th)) x 3;
@suf[11, 12, 13] = qw(th th th);
$day{ substr $_, 0, 3 } = $day{ $_ } for (keys %day);
$month{ substr $_, 0, 3 } = $month{ $_ } for (keys %month);
my $daypat = join q(|), reverse sort keys %day;
my $monpat = join q(|), reverse sort keys %month;
my $sufpat = join q(|), reverse sort @suf;
my $dstpat = q(bst|dst);
my %ampm = ( a => 0, p => 12 ); my ($AM, $PM) = (0, 12);
my $merid = 24; my @lt = localtime time;
$dtstr = lc $dtstr;
$zone = tz_offset( $zone ) if ($zone);
1 while ($dtstr =~ s{\([^\(\)]*\)}{ }mox);
$dtstr =~ s{ (\A|\n|\z) }{ }gmox;
$dtstr =~ s{ ([\d\w\s]) [\.\,] \s }{$1 }gmox;
$dtstr =~ s{ , }{ }gmx;
$dtstr =~ s{ ($daypat) \s* (den\s)? }{ }mox;
return unless ($dtstr =~ m{ \S }mx);
if ($dtstr =~ s{ \s (\d{4}) ([-:]?) # ccyy + optional separator - or : (1)
(\d\d?) \2 # mm(1 - 12) + same separator (1)
(\d\d?) # dd(1 - 31)
(?:[Tt ]
(\d\d?) # H or HH
(?:([-:]?) # Optionally separator - or : (2)
(\d\d?) # and M or MM
(?:\6 # Optionally same separator (2)
(\d\d?) # and S or SS
(?:[.,] # Optionally separator . or ,
(\d+) )? # and fractions of a second
)? )? )?
(?=\D)
}{ }mx) {
($year, $month, $day, $hh, $mm, $ss, $frac)
= ($1, $3-1, $4, $5, $7, $8, $9);
}
unless (defined $hh) {
if ($dtstr =~ s{ [:\s] (\d\d?) : (\d\d?) ( : (\d\d?) (?:\.\d+)? )? \s*
(?:([ap]) \.?m?\.? )? \s }{ }mox) {
($hh, $mm, $ss) = ($1, $2, $4 || 0);
$merid = $ampm{ $5 } if ($5);
}
elsif ($dtstr =~ s{ \s (\d\d?) \s* ([ap]) \.?m?\.? \s }{ }mox) {
($hh, $mm, $ss) = ($1, 0, 0);
$merid = $ampm{ $2 };
}
}
if (defined $hh && $hh <= 12 && $dtstr =~ s{ ([ap]) \.?m?\.? \s }{ }mox) {
$merid = $ampm{ $1 };
}
unless (defined $year) {
TRY: {
if ($dtstr =~ s{ \s (\d\d?) ([^\d_]) ($monpat) (\2(\d\d+))? \s}{ }mox) {
($year, $month, $day) = ($5, $month{ $3 }, $1);
last TRY;
}
if ($dtstr =~ s{ \s (\d+) ([\-\./]) (\d\d?) (\2(\d+))? \s }{ }mox) {
($year, $month, $day) = ($5, $3 - 1, $1);
($year, $day) = ($1, $5) if ($day > 31);
return if (length $year > 2 and $year < 1901);
last TRY;
}
if ($dtstr =~ s{ \s (\d+) \s* ($sufpat)? \s* ($monpat) }{ }mox) {
($month, $day) = ($month{ $3 }, $1);
last TRY;
}
if ($dtstr =~ s{ ($monpat) \s* (\d+) \s* ($sufpat)? \s }{ }mox) {
($month, $day) = ($month{ $1 }, $2);
last TRY;
}
if ($dtstr =~ s{ \s (\d\d) (\d\d) (\d\d) \s }{ }mox) {
($year, $month, $day) = ($3, $2 - 1, $1);
}
} # TRY
if (! defined $year && $dtstr =~ s{ \s (\d{2} (\d{2})?)[\s\.,] }{ }mox) {
$year = $1;
}
}
$dst = 1 if ($dtstr =~ s{ \b ($dstpat) \b }{}mox);
if ($dtstr =~ s{ \s \"? ([a-z]{3,4})
($dstpat|\d+[a-z]*|_[a-z]+)? \"? \s }{ }mox) {
$zone = tz_offset( $1 || 0 );
$dst = 1 if ($2 && $2 =~ m{ $dstpat }msx);
return unless (defined $zone);
}
elsif ($dtstr =~ s{ \s ([a-z]{3,4})? ([\-\+]?) -?
(\d\d?) :? (\d\d)? (00)? \s }{ }mox) {
$zone = tz_offset( $1 || 0 );
return unless (defined $zone);
$h = "$2$3";
$m = defined $4 ? "$2$4" : 0;
$zone += 60 * ($m + (60 * $h));
}
if ($dtstr =~ m{ \S }msx) {
if ($dtstr =~ s{ \A \s*(ut?|z)\s* \z }{}msx) {
$zone = 0;
}
elsif ($dtstr =~ s{ \s ([a-z]{3,4})? ([\-\+]?) -?
(\d\d?) (\d\d)? (00)? \s }{ }mox) {
$zone = tz_offset( $1 || 0 );
return unless (defined $zone);
$h = "$2$3";
$m = defined $4 ? "$2$4" : 0;
$zone += 60 * ($m + (60 * $h));
}
return if ($dtstr =~ m{ \S }mox);
}
if (defined $hh) {
if ($hh == 12) { $hh = 0 if ($merid == $AM) }
elsif ($merid == $PM) { $hh += 12 }
}
$year -= 1900 if (defined $year && $year > 1900);
$zone += 3600 if (defined $zone && $dst);
$month = $lt[4] unless(defined $month);
$day = $lt[3] unless(defined $day);
unless (defined $year) {
$year = $month > $lt[4] ? $lt[5] - 1 : $lt[5];
}
$hh = 0 unless (defined $hh);
$mm = 0 unless (defined $mm);
$ss = 0 unless (defined $ss);
$frac = 0 unless (defined $frac);
return unless ($month <= 11 && $day >= 1 && $day <= 31
&& $hh <= 23 && $mm <= 59 && $ss <= 59);
if (defined $zone) {
$result = eval {
local $SIG{__DIE__} = sub {}; # Ick!
timegm( $ss, $mm, $hh, $day, $month, $year );
};
return if (! defined $result ||
($result == -1
&& (join q(), $ss, $mm, $hh, $day, $month, $year)
ne q(595923311169)));
$result -= $zone;
}
else {
$result = eval {
local $SIG{__DIE__} = sub {}; # Ick!
timelocal($ss, $mm, $hh, $day, $month, $year);
};
return if (! defined $result ||
($result == -1
&& (join q(), $ss, $mm, $hh, $day, $month, $year)
ne join q(), (localtime -1)[0 .. 5]));
}
return $result + $frac;
}
sub time2str {
my ($self, $format, $time) = @_;
require Date::Format;
return Date::Format::Generic->time2str( $format, $time );
}
1;
__END__
# Local Variables:
# mode: perl
# tab-width: 3
# End: