view release on metacpan or  search on metacpan

lib/DateTimeX/Lite/Duration.pm  view on Meta::CPAN

package DateTimeX::Lite::Duration;
use strict;
use warnings;
use Scalar::Util qw(blessed);

use Carp ();

use overload ( fallback => 1,
               '+'   => '_add_overload',
               '-'   => '_subtract_overload',
               '*'   => '_multiply_overload',
               '<=>' => '_compare_overload',
               'cmp' => '_compare_overload',
             );

use constant MAX_NANOSECONDS => 1_000_000_000;  # 1E9 = almost 32 bits

my @all_units = qw( months days minutes seconds nanoseconds );

# XXX - need to reject non-integers but accept infinity, NaN, &
# 1.56e+18
sub new
{
    my ($class, %p) = @_;
    foreach my $field (qw(years months weeks days hours minutes seconds nanoseconds)) {
        $p{$field} = 0 unless defined $p{$field};
    }
        
=head1
    my %p = validate( @_,
                         { years   => { type => SCALAR, default => 0 },
                           months  => { type => SCALAR, default => 0 },
                           weeks   => { type => SCALAR, default => 0 },
                           days    => { type => SCALAR, default => 0 },
                           hours   => { type => SCALAR, default => 0 },
                           minutes => { type => SCALAR, default => 0 },
                           seconds => { type => SCALAR, default => 0 },
                           nanoseconds => { type => SCALAR, default => 0 },
                           end_of_month => { type => SCALAR, default => undef,
                                             regex => qr/^(?:wrap|limit|preserve)$/ },
                         } );
=cut

    my $self = bless {}, $class;

    $self->{months} = ( $p{years} * 12 ) + $p{months};

    $self->{days} = ( $p{weeks} * 7 ) + $p{days};

    $self->{minutes} = ( $p{hours} * 60 ) + $p{minutes};

    $self->{seconds} = $p{seconds};

    if ( $p{nanoseconds} )
    {
        $self->{nanoseconds} = $p{nanoseconds};
        $self->_normalize_nanoseconds;
    }
    else
    {
        # shortcut - if they don't need nanoseconds
        $self->{nanoseconds} = 0;
    }

    $self->{end_of_month} =
        ( defined $p{end_of_month}
          ? $p{end_of_month}
          : $self->{months} < 0
          ? 'preserve'
          : 'wrap'
        );

    return $self;
}

# make the signs of seconds, nanos the same; 0 < abs(nanos) < MAX_NANOS
# NB this requires nanoseconds != 0 (callers check this already)
sub _normalize_nanoseconds
{
    my $self = shift;