Net::Analysis::Time - value object for [tv_sec, tv_usec] times


Net-Analysis documentation Contained in the Net-Analysis distribution.

Index


Code Index:

NAME

Top

Net::Analysis::Time - value object for [tv_sec, tv_usec] times

SYNOPSIS

Top

  use Net::Analysis::Time;

  my $t1 = Net::Analysis::Time->new(10812345, 123456);
  my $t2 = Net::Analysis::Time->new(10812356, 123456);

  my $diff = $t2-$t1; # == new Time Object

  print "$diff\n"; # == "11.000000"

  $t1->round_usec(10000); # "$t1" == "10812345.120000";

DESCRIPTION

Top

Can't believe I've found myself implementing a date/time module. The shame of it.

This is a heavily overloaded object, so '+', '-' do what you expect.

There is some format stuff to change how it stringfies, and some stuff for rounding off values, used elsewhere for time-boxing.

This stuff should probably all be junked as soon as someone wants some efficiency.

new ($sec [, $usec] )

If passed a single floating point arg, does what it can, but don't blame me if rounding errors knacker things up.

Best to pass two ints, one seconds and one microseconds.

clone ()

Returns a new object, holding the same time value as the invocant.

round_usec ($usec_step [, $round_up_not_down])

Rounds the time down to the nearest usec_step value. Valid values between 10 and 1000000. A value of 1000000 will round to the nearest second.

Optional argument, if true, causes rounding to go up, not down.

CLASS METHODS

Top

set_format ($format)

Set the default output format for stringification of the date/time. The parameter is either a strftime(3) compliant string, or a named format:

  raw  - 1100257189.123456
  time - 10:59:49.123456
  full - 2004/11/12 10:59:49.123456

Returns the old format.

EXPORT

None by default.

AUTHOR

Top

Adam B. Worrall, <worrall@cpan.org>

COPYRIGHT AND LICENSE

Top


Net-Analysis documentation Contained in the Net-Analysis distribution.
package Net::Analysis::Time;
# $Id: Time.pm 131 2005-10-02 17:24:31Z abworrall $

use 5.008000;
our $VERSION = '0.01';
use strict;
use warnings;
use Carp qw(carp croak confess);
use POSIX qw(strftime);
use overload
    q("")  => \&as_string,
    q(0+)  => \&as_number,
    q(+=)  => \&inceq,
    q(-=)  => \&deceq, #)
    q(+)   => \&addition,
    q(-)   => \&subtraction,    #)
    q(<=>) => \&numerical_cmp;

our $Default_format = ''; # No format, raw epoch

# {{{ POD

# }}}

#### Public methods
#
# {{{ new

# {{{ POD

# }}}

sub new {
    my ($class, $s, $us) = @_;

    # If it looks like we've been passed floating point seconds, sort it out
    if (!defined $us && ($s - int($s))) {
        ($s, $us) = _breakup_float ($s);
    }

    $us = 0 if (!defined $us);

    return bless ({'s'=>$s, us=>$us}, $class);
}

# }}}
# {{{ clone

# {{{ POD

# }}}

sub clone {
    my ($self) = shift;

    my $new = { %$self };

    return bless $new => ref($self); # Copy class over
}

# }}}
# {{{ numbers

sub numbers {
    my $self = shift;
    return (wantarray)
            ? ( $self->{'s'}, $self->{us} )
            : [ $self->{'s'}, $self->{us} ];
}

# }}}
# {{{ round_usec

sub round_usec {
    my ($self, $val, $up) = @_;

    if ($val < 10 || $val > 1000000) {
        croak ("round_usec([10-1000000]), not '$val'\n");
    }

    $self->{rem} = $self->{us} % $val;

    $self->{us} -= $self->{rem};

    if ($up && $self->{rem}) {
        if ($val == 1000000) {
            $self->{'s'}++;
        } else {
            $self->{us} += $val ; # round up, not down
        }

        $self->{rem} = $val - $self->{rem}; # Allow for one level of restore
    }
}

# }}}
# {{{ usec

sub usec {
    my $self = shift;

    return $self->{'s'} * 1000000 + $self->{us};
}

# }}}

#### Overload methods
#
# {{{ as_string

sub as_string {
    my ($self, $fmt) = @_;
    my $ret = '';

    # If we've been passed an explicit format, override the default for
    #  the scope of this execution.
    local $Default_format = $Default_format;
    Net::Analysis::Time->set_format($fmt) if ($fmt);

    if ($Default_format) {
        $ret = strftime($Default_format, gmtime($self->{'s'}));
    } else {
        $ret = $self->{'s'};
    }

    return $ret . sprintf (".%06d", $self->{us});
}

# }}}
# {{{ as_number

sub as_number {
    my ($self) = shift;

    return $self->{'s'} + ($self->{us} / 1000000);
}

# }}}
# {{{ numerical_cmp

sub numerical_cmp {
    # If the seconds agree, it's down to the microseconds ...
    if (ref($_[0]) ne 'Net::Analysis::Time' ||
        ref($_[1]) ne 'Net::Analysis::Time')
    {
        confess "Time<=> args bad: ".ref($_[0]).", ".ref($_[1])."\n";
    }

    if ($_[0]->{'s'} == $_[1]->{'s'}) {
        return ($_[0]->{'us'} <=> $_[1]->{'us'});
    }
    return ($_[0]->{'s'} <=> $_[1]->{'s'});
}

# }}}
# {{{ inceq

sub inceq {
    my ($arg1, $arg2, $arg3) = @_;

    # Should really work out what to do here ..
    die "we have arg3 1 !\n".Data::Dumper::Dumper(\@_) if ($arg3);

    $arg1->_add (_arg_to_nums ($arg2));

    return $arg1;
}

# }}}
# {{{ deceq

sub deceq {
    my ($arg1, $arg2, $arg3) = @_;

    # Should really work out what to do here ..
    die "we have arg3 2 !\n".Data::Dumper::Dumper(\@_) if ($arg3);

    $arg1->_subtract (_arg_to_nums ($arg2));

    return $arg1;
}

# }}}
# {{{ addition

sub addition {
    my ($arg1, $arg2, $arg3) = @_;

    # Should really work out what to do here ..
    die "we have arg3 3!\n".Data::Dumper::Dumper(\@_) if ($arg3);

    my $new = $arg1->clone();

    $new->_add (_arg_to_nums ($arg2));

    return $new;
}

# }}}
# {{{ subtraction

sub subtraction {
    my ($arg1, $arg2, $arg3) = @_;

    # Should really work out what to do here ..
    confess "we have arg3 4!\n".Data::Dumper::Dumper(\@_) if ($arg3);

    my $new = $arg1->clone();

    $new->_subtract (_arg_to_nums ($arg2));

    return $new;
}

# }}}

#### Class methods
#
# {{{ set_format

sub set_format {
    my ($class, $fmt) = @_;
    my (%format_shortcuts) = (raw  => '',
                              full => '%Y/%m/%d %T',
                              time => '%T',
                             );
    my $old_format = $Default_format;

    if (exists $format_shortcuts{$fmt}) {
        $Default_format = $format_shortcuts{$fmt};
    } else {
        $Default_format = $fmt;
    }

    return $old_format;
}

# }}}

#### Helpers
#
# {{{ _breakup_float

sub _breakup_float {
    my ($f) = shift;

    # Break up float with: int (rounds down), and sprintf (rounds closest)
    my $s  = int($f);
    my $us = sprintf ("%6d", ($f - $s) * 1000000);

    return (wantarray) ? ($s,$us) : [$s,$us];
}

# }}}
# {{{ _arg_to_nums

sub _arg_to_nums {
    my ($arg) = @_;

    if (! ref($arg)) {
        return _breakup_float($arg);

    } elsif (ref ($arg) eq 'ARRAY') {
        return (@$arg);

    } elsif (ref ($arg) eq 'Net::Analysis::Time') {
        return ($arg->{'s'}, $arg->{us});

    } else {
        die "could not make arg '$arg' into time: ".Data::Dumper::Dumper($arg);
    }
}

# }}}

# {{{ _add

sub _add {
    my ($self, $s, $us) = @_;

    $self->{'s'}  += $s;

    # Catch overflows
    if (($self->{'us'} += $us) > 1000000) {
        $self->{'s'}++;
        $self->{'us'} -= 1000000;
    }
}

# }}}
# {{{ _subtract

sub _subtract {
    my ($self, $s, $us) = @_;

    $self->{'s'}  -= $s;

    # Catch underflows
    if (($self->{'us'} -= $us) < 0) {
        $self->{'s'}--;
        $self->{'us'} += 1000000;
    }
}

# }}}

1;
__END__
# {{{ POD

# }}}

# {{{ -------------------------={ E N D }=----------------------------------

# Local variables:
# folded-file: t
# end:

# }}}