File Coverage

lib/Badger/Timestamp.pm

Criterion	Covered	Total	%
statement	139	149	93.2
branch	59	68	86.7
condition	39	54	72.2
subroutine	26	27	96.3
pod	22	23	95.6
total	285	321	88.7

#========================================================================
#
# Badger::Timestamp
#
# DESCRIPTION
#   Simple object representing a date/time and providing methods for
#   accessing and manipulating various parts of it.
#
# AUTHOR
#   Andy Wardley
#
# 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
    }
    @YMDHMS
);


#-----------------------------------------------------------------------
# Constructor subroutines
#-----------------------------------------------------------------------

sub Timestamp {
    return @_
        ? TS->new(@_)
        : TS
}

sub Now {
    TS->now;
}


#-----------------------------------------------------------------------
# Methods
#-----------------------------------------------------------------------

sub new {
    my $class = shift;
    my $self  = bless { map { ($_, 0) } @YMDHMS }, ref $class || $class;
    my ($config, $time);

    if (@_ > 1) {
        # multiple arguments are named params
        $config = { @_ };
    }
    elsif (@_ == 1 && defined $_[0]) {
        # single argument is a hash of named params, a timestamp or time in
        # seconds since the epoch
        $config = ref $_[0] eq HASH ? shift : { time => shift };
    }
    # otherwise we default to now
    else {
        $config = { time => time() };
    }

    if ($time = $config->{ time }) {
        if (numlike $time) {
            # $time is seconds since epoch
            (@$self{ @YMDHMS }) = reverse( ( localtime($time) )[0..5] );
            $self->{ year  }+= 1900;
            $self->{ month }++;
            $self->{ etime } = $time;
        }
        elsif (is_object(ref $class || $class, $time)) {
            $self->{ timestamp } = $time->timestamp;
            $self->{ etime     } = $time->epoch_time;
            $self->split_timestamp;
        }
        else {
            # $time is a timestamp so split and rejoin into canonical form
            $self->{ timestamp } = $time;
            $self->split_timestamp;
        }
        $self->join_timestamp;
    }
    else {
        # set any fields defined in config, allowing singular (second,month,
        # etc) and plural (seconds, months, etc)
        foreach my $field (@YMDHMS) {
            $self->{ $field } = $config->{ $field } || $config->{"${field}s"} || 0;
        }
    }
    return $self;
}

sub now {
    shift->new;
}

sub copy {
    my $self = shift;
    $self->new( $self->{ timestamp } );
}

sub split_timestamp {
    my $self = shift;
    $self->{ timestamp } = '' unless defined $self->{ timestamp };

    # TODO: this regex should be tweaked to make time (and/or date parts) optional
    (@$self{ @YMDHMS } = map { 0+($_||0) } $self->{ timestamp } =~ m/$STAMP_REGEX/o)
        || return $self->error_msg( bad_timestamp => $self->{ timestamp } );
}

sub join_timestamp {
    my $self = shift;
    return ($self->{ timestamp } = sprintf(
        $STAMP_FORMAT,
        map { defined $_ ?  $_ : 0 }
        @$self{ @YMDHMS }
    ));
}

sub epoch_time {
    my $self = shift;
    return $self->{ etime } ||= timelocal(
        @$self{@SMHD},
        $self->{ month } - 1,
        $self->{ year  } - 1900
    );
}

sub format {
    my $self = shift;
    my $fmt  = shift;
    return strftime($fmt, @$self{@SMHD}, $self->{ month } - 1, $self->{ year } - 1900);
}

sub date {
    my $self = shift;
    return $self->{ date }
        ||= sprintf( $DATE_FORMAT, @$self{ @YMD } );
}

sub time {
    my $self = shift;
    return $self->{ time }
        ||= sprintf( $TIME_FORMAT, @$self{ @HMS });
}

sub adjust {
    my $self = shift;
    my ($args, $element, $dim);
    my $fix_month = 0;

    if (@_ == 1) {
        # single argument can be a reference to a hash: { days => 3, etc }
        # or a number/string representing a duration: "3 days", "1 year"
        $args = ref $_[0] eq HASH
            ? shift
            : { seconds => $self->duration(shift) };
    }
    else {
        # multiple arguments are named parameters: days => 3, etc.
        $args = { @_ };
    }

    # If we're only adjusting by a month or a year, then we fix the day
    # within the range of the number of days in the new month.  For example:
    # 2007-01-31 + 1 month = 2007-02-28.  We must handle this for a year
    # adjustment for the case: 2008-02-29 + 1 year = 2009-02-28
    if ((scalar(keys %$args) == 1) &&
        (defined $args->{ month } || defined $args->{ months } ||
         defined $args->{ year }  || defined $args->{ years })) {
        $fix_month = 1;
    }

    $self->debug("adjust: ", $self->dump_data($args)) if DEBUG;

    # allow each element to be singular or plural: day/days, etc.
    foreach $element (@YMDHMS) {
        $args->{ $element } = $args->{ "${element}s" }
            unless defined $args->{ $element };
    }

    # adjust the time by the parameters specified
    foreach $element (@YMDHMS) {
        $self->{ $element } += $args->{ $element }
            if defined $args->{ $element };
    }

    # Handle negative seconds/minutes/hours
    while ($self->{ second } < 0) {
        $self->{ second } += 60;
        $self->{ minute }--;
    }
    while ($self->{ minute } < 0) {
        $self->{ minute } += 60;
        $self->{ hour   }--;
    }
    while ($self->{ hour } < 0) {
        $self->{ hour   } += 24;
        $self->{ day    }--;
    }

    # now positive seconds/minutes/hours
    if ($self->{ second } > 59) {
        $self->{ minute } += int($self->{ second } / 60);
        $self->{ second } %= 60;
    }
    if ($self->{ minute } > 59) {
        $self->{ hour   } += int($self->{ minute } / 60);
        $self->{ minute } %= 60;
    }
    if ($self->{ hour   } > 23) {
        $self->{ day    } += int($self->{ hour } / 24);
        $self->{ hour   } %= 24;
    }

    # Handle negative days/months/years
    while ($self->{ day } <= 0) {
        $self->{ month }--;
        unless ($self->{ month } > 0) {
            $self->{ month } += 12;
            $self->{ year  }--;
        }
        $self->{ day } += $self->days_in_month;
    }
    while ($self->{ month } <= 0) {
        $self->{ month } += 12;
        $self->{ year } --;
    }
    while ($self->{ month } > 12) {
        $self->{ month } -= 12;
        $self->{ year  } ++;
    }

    # handle day wrap-around
    while ($self->{ day } > ($dim = $self->days_in_month)) {
        # If we're adjusting by a single month or year and the day is
        # greater than the number days in the new month, then we adjust
        # the new day to be the last day in the month.  Otherwise we
        # increment the month and remove the number of days in the current
        # month.
        if ($fix_month) {
            $self->{ day } = $dim;
        }
        else {
            $self->{ day } -= $dim;
            if ($self->{ month } == 12) {
                $self->{ month } = 1;
                $self->{ year  }++;
            }
            else {
                $self->{ month }++;
            }
        }
    }

    $self->uncache;
    $self->join_timestamp;

    return $self;
}

sub duration {
    my ($self, $duration) = @_;

    # $duration can be a number, assumed to be seconds
    return $duration
        if numlike($duration);

    # Otherwise the $duration should be of the form "3 minutes".  We only
    # 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__