File Coverage

blib/lib/ORM/Date.pm

Criterion	Covered	Total	%
statement	31	109	28.4
branch	2	34	5.8
condition			n/a
subroutine	10	40	25.0
pod	21	25	84.0
total	64	208	30.7

#
# DESCRIPTION
#   PerlORM - Object relational mapper (ORM) for Perl. PerlORM is Perl
#   library that implements object-relational mapping. Its features are
#   much similar to those of Java's Hibernate library, but interface is
#   much different and easier to use.
#
# AUTHOR
#   Alexey V. Akimov
#
# COPYRIGHT
#   Copyright (C) 2005-2006 Alexey V. Akimov
#
#   This library is free software; you can redistribute it and/or
#   modify it under the terms of the GNU Lesser General Public
#   License as published by the Free Software Foundation; either
#   version 2.1 of the License, or (at your option) any later version.
#
#   This library is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#   Lesser General Public License for more details.
#
#   You should have received a copy of the GNU Lesser General Public
#   License along with this library; if not, write to the Free Software
#   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#

package ORM::Date;

$VERSION=0.8;

use Carp;
use POSIX;
use ORM::Datetime;
use overload
        '>'   => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch >   $_[1]->epoch; },
        '<'   => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch <   $_[1]->epoch; },
        '>='  => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch >=  $_[1]->epoch; },
        '<='  => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch <=  $_[1]->epoch; },
        '=='  => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch ==  $_[1]->epoch; },
        '!='  => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch !=  $_[1]->epoch; },
        '<=>' => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch <=> $_[1]->epoch; },
        'cmp' => sub { ( my $err = _check_args( @_ ) ); $err && croak $err; $_[0]->epoch cmp $_[1]->epoch; },
        'fallback' => 1;

my $use_local_tz = 1;

##
## CONSTRUCTORS
##

sub new_epoch
{
    my $class = shift;
    my $epoch = shift;

    return bless { epoch=>$epoch }, $class;
}

sub new
{
    my $class = shift;
    my $array = shift;

    my $time = POSIX::mktime
    (
        $array->[5],
        $array->[4],
        $array->[3],
        $array->[2],
        $array->[1]-1,
        $array->[0]-1900,
        0,0,-1
    );

    unless( defined $time )
    {
        croak "Specified time [".join( ',',@$array )."] cannot be represented";
    }

    $class->new_epoch( $time );
}

sub new_mysql
{
    my $class = shift;
    my $str   = shift;
    my $date;

    if( $str =~ /^(\d{4,4})\-0*(\d+)\-0*(\d+)$/ )
    {
        $date = $class->new( [ $1, $2, $3, 0, 0, 0 ] );
    }
    elsif( $str =~ /^(\d{4,4})\-0*(\d+)\-0*(\d+)(\s+0*(\d+)\:0*(\d+)(\:0*(\d+))?)$/ )
    {
        $date = $class->new( [ $1, $2, $3, $5, $6, $8 ] );
    }

    return $date;
}

sub copy
{
    my $class = shift;
    my $self;

    if( ref $class )
    {
        $self  = $class;
        $class = ref $class;
    }
    else
    {
        $self = shift;
    }

    return $class->new_epoch( $self->{epoch} );
}

sub diff
{
    my $self = shift;
    my @diff = @{$_[0]};

    return (ref $self)->new
    (
        [
            $self->year  + $diff[0],
            $self->month + $diff[1],
            $self->mday  + $diff[2],
            $self->hour  + $diff[3],
            $self->min   + $diff[4],
            $self->sec   + $diff[5],
        ],
    );
}

sub current
{
    my $class = shift;
    my $date  = $class->new_epoch( time );
    $class->new( [$date->year,$date->month,$date->mday,0,0,0] );
}
sub earlier24h
{
    my $class = shift;
    my $date  = $class->new_epoch( time-24*60*60 );
    $class->new( [$date->year,$date->month,$date->mday,0,0,0] );
}

sub date       { ORM::Date->new_epoch( $_[0]->epoch ); }
sub datetime   { ORM::Datetime->new_epoch( $_[0]->epoch ); }

##
## OBJECT PROPERTIES
##

sub epoch { $_[0]->{epoch}; }
sub sec   { $_[0]->_tz_time( $_[0]->epoch )->[0]; }
sub min   { $_[0]->_tz_time( $_[0]->epoch )->[1]; }
sub hour  { $_[0]->_tz_time( $_[0]->epoch )->[2]; }
sub mday  { $_[0]->_tz_time( $_[0]->epoch )->[3]; }
sub wday  { $_[0]->_tz_time( $_[0]->epoch )->[6]; }
sub yday  { $_[0]->_tz_time( $_[0]->epoch )->[7]; }
sub month { $_[0]->_tz_time( $_[0]->epoch )->[4]; }
sub year  { $_[0]->_tz_time( $_[0]->epoch )->[5]; }

sub mysql_date
{
    my $self = shift;
    my $time = $self->_tz_time( $self->epoch );

    sprintf '%04d-%02d-%02d', $time->[5], $time->[4], $time->[3];
}

sub mysql_time
{
    my $self = shift;
    my $time = $self->_tz_time( $self->epoch );

    sprintf '%02d:%02d:%02d', $time->[2], $time->[1], $time->[0];
}

sub mysql_datetime
{
    my $self = shift;
    my $time = $self->_tz_time( $self->epoch );

    sprintf '%04d-%02d-%02d %02d:%02d:%02d'
        , $time->[5], $time->[4], $time->[3]
        , $time->[2], $time->[1], $time->[0];
}

sub datetime_str
{
    my $self = shift;

    scalar $self->_tz_time_str( $self->epoch );
}

##
## OBJECT METHODS
##

sub set_epoch { $_[0]->{epoch} = $_[1]; }

##
## CLASS PROPERTIES
##

sub use_local_tz { $use_local_tz = 1; }
sub use_utc_tz   { $use_local_tz = 0; }

##
## PROTECTED PROPERTIES
##

sub _tz_time
{
    my $class = shift;
    my $time  = shift;
    my @time  = $use_local_tz ? localtime $time : gmtime $time;

    $time[4] ++;
    $time[5] += 1900;

    return \@time;
}

sub _tz_time_str
{
    my $class = shift;
    my $time  = shift;

    return $use_local_tz ? localtime $time : gmtime $time;
}

sub _check_args
{
    my @arg = $_[2] ? ( $_[1], $_[0] ) : @_;
    my $err = undef;

    if( ! UNIVERSAL::isa( $arg[0], 'ORM::Date' ) )
    {
        $err = "First arg must be an 'ORM::Date' instance.";
    }
    elsif( ! UNIVERSAL::isa( $arg[1], 'ORM::Date' ) )
    {
        $err = "Second arg must be an 'ORM::Date' instance.";
    }

    $err;
}

1;