Badger
view release on metacpan or search on metacpan
lib/Badger/Timestamp.pm view on Meta::CPAN
#========================================================================
#
# Badger::Timestamp
#
# DESCRIPTION
# Simple object representing a date/time and providing methods for
# accessing and manipulating various parts of it.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 2001-2009 Andy Wardley. All Rights Reserved.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
#========================================================================
package Badger::Timestamp;
use Badger::Class
version => 0.03,
debug => 0,
import => 'class CLASS',
base => 'Badger::Base',
utils => 'numlike self_params is_object',
accessors => 'timestamp',
as_text => 'timestamp',
is_true => 1,
methods => {
not_equal => \&compare,
},
overload => {
'!=' => \¬_equal,
'==' => \&equal,
'<' => \&before,
'>' => \&after,
'<=' => \¬_after,
'>=' => \¬_before,
fallback => 1,
},
constants => 'HASH',
constant => {
TS => __PACKAGE__,
TIMESTAMP => __PACKAGE__,
},
exports => {
any => 'TS TIMESTAMP Timestamp Now',
},
messages => {
bad_timestamp => 'Invalid timestamp: %s',
bad_duration => 'Invalid duration: %s',
};
use Time::Local;
use POSIX 'strftime';
# Example timestamp: 2006/12/31 23:59:59
our $DATE_REGEX = qr{ (\d{4})\D(\d{1,2})\D(\d{1,2}) }x;
our $TIME_REGEX = qr{ (\d{1,2})\D(\d{2})\D(\d{2}) }x;
our $STAMP_REGEX = qr{ ^\s* $DATE_REGEX (?:(?:T|\s) $TIME_REGEX)? }x;
our $DATE_FORMAT = '%04d-%02d-%02d';
our $LONGDATE_FORMAT = '%02d-%3s-%04d';
our $TIME_FORMAT = '%02d:%02d:%02d';
our $STAMP_FORMAT = "$DATE_FORMAT $TIME_FORMAT";
our @YMD = qw( year month day );
our @HMS = qw( hour minute second );
our @SMHD = qw( second minute hour day );
our @YMDHMS = (@YMD, @HMS);
our @MONTHS = qw( xxx Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
our @CACHE = qw( date time etime longmonth longdate );
our $SECONDS = {
s => 1,
m => 60,
h => 60*60,
d => 60*60*24,
M => 60*60*24*30,
y => 60*60*24*365,
};
#-----------------------------------------------------------------------
# Method generator: second()/seconds(), hour()/hours(), etc.
#-----------------------------------------------------------------------
class->methods(
map {
my $item = $_; # lexical copy for closure
my $items = $_ . 's'; # provide singular and plural versions
my $code = sub {
if (@_ > 1) {
$_[0]->{ $item } = $_[1];
$_[0]->join_timestamp;
return $_[0];
}
return $_[0]->{ $item };
};
$item => $code,
$items => $code
lib/Badger/Timestamp.pm view on Meta::CPAN
# look at the first character of the word (e.g. "3 m"), which creates a
# potential conflict between "m(inute) and m(onth)". So we use a capital
# 'M' for month. This is based on code by Mark Fisher in CGI.pm.
$duration =~ s/month/Month/i;
# TODO: make this parser a bit smarter so we can support multiple
# items (e.g. "2 hours 30 minutes") as per adjust()
if ($duration =~ /^ ( -? (?: \d+ | \d*\.\d+ ) ) \s* ([smhdMy]?) /x) {
return ($SECONDS->{ $2 } || 1) * $1;
}
else {
return $self->error_msg( bad_duration => $duration );
}
}
sub uncache {
my $self = shift;
delete @$self{@CACHE};
return $self;
}
sub compare {
my $self = shift;
# optimisation: if the $self object has an epoch time and a single
# numerical argument is passed (also an epoch time) then we can do a
# simple comparison
return $self->{ etime } <=> $_[0]
if $self->{ etime }
&& @_ == 1
&& numlike $_[0];
# otherwise we upgrade any argument(s) to another timestamp and comare
# them piecewise
my $comp = @_ && is_object(ref $self || $self, $_[0]) ? shift : $self->new(@_);
foreach my $item (@YMDHMS) {
if ($self->{ $item } < $comp->{ $item }) {
return -1; # -1 - self earlier than comparison timestamp
}
elsif ($self->{ $item } > $comp->{ $item }) {
return 1; # 1 - self later than comparison timestamp
}
}
return 0; # 0 - same time
}
sub equal {
shift->compare(@_) == 0;
}
sub before {
shift->compare(@_) == -1;
}
sub after {
shift->compare(@_) == 1;
}
sub not_before {
shift->compare(@_) >= 0;
}
sub not_after {
shift->compare(@_) <= 0;
}
sub tm_wday {
my $self = shift;
return (localtime($self->epoch_time))[6];
}
sub days_in_month {
my $self = shift;
my $month = shift || $self->{ month };
if ($month == 4 || $month == 6 || $month == 9 || $month == 11) {
return 30;
}
elsif ($month == 2) {
return $self->leap_year(@_) ? 29 : 28;
}
else {
return 31;
}
}
sub leap_year {
my $self = shift;
my $year = shift || $self->{ year };
if ($year % 4) {
return 0;
}
elsif ($year % 400 == 0) {
return 1;
}
elsif ($year % 100 == 0) {
return 0;
}
else {
return 1;
}
}
1;
__END__
=head1 NAME
Badger::Timestamp - object representation of a timestamp
=head1 SYNOPSIS
use Badger::Timestamp;
# timestamp defaults to date/time now
my $stamp = Badger::Timestamp->new();
my $stamp = Badger::Timestamp->now(); # alias to new()
# construct from seconds since epoch
my $stamp = Badger::Timestamp->new($epoch_seconds);
# or from ISO-8601 timestamp (or similar)
my $stamp = Badger::Timestamp->new('2006-03-19 04:20:42');
lib/Badger/Timestamp.pm view on Meta::CPAN
$stamp->before($another_timestamp_object);
$stamp->before('2009-04-20 04:20:00');
$stamp->before($epoch_seconds);
$stamp->before; # before now
The method returns -1 if the timestamp object represents a time before the
timestamp passed as an argument, 1 if it's after, or 0 if it's equal.
=head2 equal($when)
This is a method of convenience which uses L<compare()> to test if two
timestamps are equal. You can pass it any of the arguments accepted by the
L<compare()> method.
if ($time1->equal($time2)) {
print "both timestamps are equal\n";
}
This method is overloaded onto the C<==> operator, allowing you to perform
more natural comparisons.
if ($time1 == $time2) {
print "both timestamps are equal\n";
}
=head2 before($when)
This is a method of convenience which uses L<compare()> to test if one
timestamp occurs before another. It returns a true value (1) if the first
timestamp (the object) is before the second (the argument), or a false value
(0) otherwise.
if ($time1->before($time2)) {
print "time1 is before time2\n";
}
This method is overloaded onto the C<E<lt>> operator.
if ($time1 < $time2) {
print "time1 is before time2\n";
}
=head2 after($when)
This is a method of convenience which uses L<compare()> to test if one
timestamp occurs after another. It returns a true value (1) if the first
timestamp (the object) is after the second (the argument), or a false value
(0) otherwise.
if ($time1->after($time2)) {
print "time1 is after time2\n";
}
This method is overloaded onto the C<E<gt>> operator.
if ($time1 > $time2) {
print "time1 is after time2\n";
}
=head2 not_equal($when)
This is an alias to the L<compare()> method. It returns a true value (-1 or
+1, both of which Perl considers to be true values) if the timestamps are not
equal or false value (0) if they are.
if ($time1->not_equal($time2)) {
print "time1 is not equal to time2\n";
}
This method is overloaded onto the C<!=> operator.
if ($time1 != $time2) {
print "time1 is not equal to time2\n";
}
=head2 not_before($when)
This is a method of convenience which uses L<compare()> to test if one
timestamp does not occur before another. It returns a true value (1) if the
first timestamp (the object) is equal to or after the second (the argument),
or a false value (0) otherwise.
if ($time1->not_before($time2)) {
print "time1 is not before time2\n";
}
This method is overloaded onto the C<E<gt>=> operator.
if ($time1 >= $time2) {
print "time1 is not before time2\n";
}
=head2 not_after($when)
This is a method of convenience which uses L<compare()> to test if one
timestamp does not occur after another. It returns a true value (1) if the
first timestamp (the object) is equal to or before the second (the argument),
or a false value (0) otherwise.
if ($time1->not_after($time2)) {
print "time1 is not after time2\n";
}
This method is overloaded onto the C<E<lt>=> operator.
if ($time1 <= $time2) {
print "time1 is not after time2\n";
}
=head2 adjust(%adjustments)
Method to adjust the timestamp by a fixed amount or amounts.
# positive adjustment
$date->adjust( months => 6, years => 1 );
# negative adjustment
$date->adjust( months => -18, hours => -200 );
Named parameters can be passed as arguments or via a hash reference.
$date->adjust( months => -18, hours => -200 ); # naked
$date->adjust({ months => -18, hours => -200 }); # clothed
You can specify units using singular (second, hour, month, etc) or plural
(seconds, hours, minutes, etc) keys. The method will correctly handle values
outside the usual ranges. For example, you can specify a change of 18 months,
-200 hours, -99 seconds, and so on.
A single non-reference argument is assumed to be a duration which is
converted to a number of seconds via the L<duration()> method.
=head2 duration($duration)
Returns the number of seconds in a duration. A single numerical argument is
assumed to be a number of seconds and is returned unchanged.
$date->adjust(300); # 300 seconds
A single non-numerical argument should have a suffix indicating the units.
In "compact form" this is a single letter. We use lower case C<m> for
minutes and upper case C<M> for months.
$date->adjust("300s"); # or "300 seconds"
$date->adjust("90m"); # or "90 minutes"
$date->adjust("3h"); # or "3 hours"
$date->adjust("2d"); # or "2 days"
$date->adjust("6M"); # or "6 months"
$date->adjust("5y"); # or "5 years"
Alternately you can spell the units out in full as shown in the right
column above. However, we only look at the first character of the following
word so you can write all sorts of nonsense which we will dutifully accept
without complaint.
$date->adjust("5 sheep"); # 5 seconds
$date->adjust("9 men"); # 9 minutes
$date->adjust("3 yaks"); # 3 years
For the sake of convenience, the method will automatically convert the
( run in 0.974 second using v1.01-cache-2.11-cpan-98e64b0badf )