duration.pm

1. 记录每个帖子的访问人情况

package DateTime::Duration;

use strict;

use Params::Validate qw( validate SCALAR );

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 );

sub new
{
    my $class = shift;
    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)$/ },
                         } );

    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;

    return if
        ( $self->{nanoseconds} == DateTime::INFINITY()
          || $self->{nanoseconds} == DateTime::NEG_INFINITY()
          || $self->{nanoseconds} eq DateTime::NAN()
        );

    my $seconds = $self->{seconds} + $self->{nanoseconds} / MAX_NANOSECONDS;
    $self->{seconds} = int( $seconds );
    $self->{nanoseconds} = $self->{nanoseconds} % MAX_NANOSECONDS;
    $self->{nanoseconds} -= MAX_NANOSECONDS if $seconds < 0;
}

sub clone { bless { %{ $_[0] } }, ref $_[0] }

sub years   { abs( $_[0]->in_units( 'years' ) ) }
sub months  { abs( $_[0]->in_units( 'months', 'years' ) ) }
sub weeks   { abs( $_[0]->in_units( 'weeks' ) ) }
sub days    { abs( $_[0]->in_units( 'days', 'weeks' ) ) }
sub hours   { abs( $_[0]->in_units( 'hours' ) ) }
sub minutes { abs( $_[0]->in_units( 'minutes', 'hours' ) ) }
sub seconds { abs( $_[0]->in_units( 'seconds' ) ) }
sub nanoseconds { abs( $_[0]->in_units( 'nanoseconds', 'seconds' ) ) }

sub is_positive {   $_[0]->_has_positive && ! $_[0]->_has_negative }
sub is_negative { ! $_[0]->_has_positive &&   $_[0]->_has_negative }

sub _has_positive { ( grep { $_ > 0 } @{ $_[0] }{@all_units} ) ? 1 : 0}
sub _has_negative { ( grep { $_ < 0 } @{ $_[0] }{@all_units} ) ? 1 : 0 }

sub is_zero       { return 0 if grep { $_ != 0 } @{ $_[0] }{@all_units};
                    return 1 }

sub delta_months  { $_[0]->{months} }
sub delta_days    { $_[0]->{days} }
sub delta_minutes { $_[0]->{minutes} }
sub delta_seconds { $_[0]->{seconds} }
sub delta_nanoseconds { $_[0]->{nanoseconds} }

sub deltas
{
    map { $_ => $_[0]->{$_} } @all_units;
}

sub in_units
{
    my $self  = shift;
    my @units = @_;

    my %units = map { $_ => 1 } @units;

    my %ret;

    my ( $months, $days, $minutes, $seconds ) =
        @{ $self }{qw( months days minutes seconds )};

    if ( $units{years} )
    {
        $ret{years} = int( $months / 12 );
        $months -= $ret{years} * 12;
    }

    if ( $units{months} )
    {
        $ret{months} = $months;
    }

    if ( $units{weeks} )
    {
        $ret{weeks} = int( $days / 7 );
        $days -= $ret{weeks} * 7;
    }

    if ( $units{days} )
    {
        $ret{days} = $days;
    }

    if ( $units{hours} )
    {
        $ret{hours} = int( $minutes / 60 );
        $minutes -= $ret{hours} * 60;
    }
    if ( $units{minutes} )
    {
        $ret{minutes} = $minutes
    }

    if ( $units{seconds} )
    {
        $ret{seconds} = $seconds;
        $seconds = 0;
    }

    if ( $units{nanoseconds} )
    {
        $ret{nanoseconds} = $seconds * MAX_NANOSECONDS + $self->{nanoseconds};
    }

    wantarray ? @ret{@units} : $ret{ $units[0] };
}

sub is_wrap_mode     { $_[0]->{end_of_month} eq 'wrap'   ? 1 : 0 }
sub is_limit_mode    { $_[0]->{end_of_month} eq 'limit'  ? 1 : 0 }
sub is_preserve_mode { $_[0]->{end_of_month} eq 'preserve' ? 1 : 0 }

sub inverse
{
    my $self = shift;

    my %new;
    foreach my $u (@all_units)
    {
        $new{$u} = $self->{$u};
        # avoid -0 bug
        $new{$u} *= -1 if $new{$u};
    }

    return (ref $self)->new(%new);
}

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

    foreach my $u (@all_units)
    {
        $self->{$u} += $dur->{$u};
    }

    $self->_normalize_nanoseconds if $self->{nanoseconds};

    return $self;
}

sub add
{
    my $self = shift;

    return $self->add_duration( (ref $self)->new(@_) );
}

sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }

sub subtract
{
    my $self = shift;

    return $self->subtract_duration( (ref $self)->new(@_) )
}

sub multiply
{
    my $self = shift;
    my $multiplier = shift;

    foreach my $u (@all_units)
    {
        $self->{$u} *= $multiplier;
    }

    $self->_normalize_nanoseconds if $self->{nanoseconds};

    return $self;
}

sub compare
{
    my ( $class, $dur1, $dur2, $dt ) = @_;

    $dt ||= DateTime->now;

    return
        DateTime->compare( $dt->clone->add_duration($dur1), $dt->clone->add_duration($dur2) );
}

sub _add_overload
{
    my ( $d1, $d2, $rev ) = @_;

    ($d1, $d2) = ($d2, $d1) if $rev;

    if ( UNIVERSAL::isa( $d2, 'DateTime' ) )
    {
        $d2->add_duration($d1);
        return;
    }

    # will also work if $d1 is a DateTime.pm object
    return $d1->clone->add_duration($d2);
}

sub _subtract_overload
{
    my ( $d1, $d2, $rev ) = @_;

    ($d1, $d2) = ($d2, $d1) if $rev;

    die "Cannot subtract a DateTime object from a DateTime::Duration object"
        if UNIVERSAL::isa( $d2, 'DateTime' );

    return $d1->clone->subtract_duration($d2);
}