The attached module is a time-only implementation of DateTime. This is a very early developer release. This module will be released to the DateTime community as I think it's too important a module to take on the responsibility of maintaining it myself. Please do what you will with this module. The docs are in the POD (as is the rationale).
Feel free to change anything about it. Send me patches. Rewrite it. I'll maintain it until someone says to do something else with it. Putting it on CVS would probably be good. There's no tests yet, just this one file. (Oh, a note: I tried (and would like to try) to keep this separate from DateTime. It should be able to be installed without installing DateTime) Cheers! Rick (By the way, it's a long weekend here this weekend so I should get the patches for DateTime.pm and Strptime.pm and the converter for Locale.pm finished .. they're all inter-related and are pretty much done. I just need to proof it all)
Time.pm
Description: application/applefile
package DateTime::Time;
use strict;
use Carp;
use vars qw($VERSION);
$VERSION = '0.0100';
#use DateTime::Duration;
use Params::Validate qw( validate SCALAR BOOLEAN HASHREF OBJECT );
use overload ( 'fallback' => 1,
'<=>' => '_compare_overload',
'cmp' => '_compare_overload',
'-' => '_subtract_overload',
'+' => '_add_overload',
);
use constant MAX_NANOSECONDS => 1_000_000_000; # 1E9 = almost 32 bits
sub new {
my $class = shift;
my %p = validate( @_,
{ months => { 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 },
fractional_second =>
{ type => SCALAR, default => undef },
}
);
croak "DateTime::Time does not handle months" if $p{months};
if ( defined $p{fractional_second} ) {
my $int = int( $p{fractional_second} );
$p{seconds} += $int;
$p{nanoseconds} += ( $p{fractional_second} - $int ) * MAX_NANOSECONDS;
}
# We convert from a hash because we think of everything as seconds
# The we convert back to a hash to save doing so every time we access
# one of the accessor methods
my %self = seconds2hash(hash2seconds(%p));
$self{as_seconds} = hash2seconds(%self);
return bless \%self, $class;
}
sub now {
my $class = shift;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
return $class->new(
hours => $hour,
minutes => $min,
seconds => $sec
);
}
sub from_object {
my $class = shift;
my %p = validate( @_,
{ object => { type => OBJECT,
isa => 'DateTime::Duration',
},
},
);
return $class->new(
months => $p{object}->delta_months,
days => $p{object}->delta_days,
minutes => $p{object}->delta_minutes,
seconds => $p{object}->delta_seconds,
nanoseconds => $p{object}->delta_nanoseconds,
);
}
sub as_object {
return new DateTime::Duration(seconds => $_[0]->as_seconds);
}
sub hash2seconds {
my %p = @_;
return (($p{days} * 24 + $p{hours}) * 60 + $p{minutes}) * 60 + $p{seconds} +
($p{nanoseconds} / MAX_NANOSECONDS);
}
sub seconds2hash {
my $s = shift;
my %p;
$p{days} = int($s / (60*60*24));
$s -= $p{days} * 60*60*24;
$p{hours} = int($s / (60*60));
$s -= $p{hours} * 60*60;
$p{minutes} = int($s / 60);
$s -= $p{minutes} * 60;
$p{seconds} = int($s);
$s -= $p{seconds};
$p{nanoseconds} = $s * MAX_NANOSECONDS;
return %p;
}
sub clone { bless { %{ $_[0] } }, ref $_[0] }
# ACCESSOR METHODS
sub fractional_seconds { $_[0]->as_seconds - int($_[0]->as_seconds) }
sub nanoseconds { int($_[0]->{nanoseconds}) }
sub milliseconds { int($_[0]->{nanoseconds} / 1000) }
sub microseconds { int($_[0]->{nanoseconds} / 1000000) }
sub seconds { $_[0]->{seconds} }
sub minutes { $_[0]->{minutes} }
sub hours { $_[0]->{hours} }
sub days { $_[0]->{days} }
# AS ACCESSOR METHODS
sub as_nanoseconds { $_[0]->{as_seconds} * MAX_NANOSECONDS }
sub as_milliseconds { $_[0]->{as_seconds} * 1000000 }
sub as_microseconds { $_[0]->{as_seconds} * 1000 }
sub as_seconds { $_[0]->{as_seconds} }
sub as_minutes { $_[0]->{as_seconds} / 60 }
sub as_hours { $_[0]->{as_seconds} / (60*60) }
sub as_days { $_[0]->{as_seconds} / (60*60*24) }
# FORMATING METHODS
sub dhms {
my $self = shift;
my @sep = @_[0..1];
@sep = (':') unless defined @sep;
return sprintf( "%02d%s%02d%s%02d%s%02d",
$self->{days}, $sep[0],
$self->{hours}, $sep[1] || $sep[0],
$self->{minutes}, $sep[2] || $sep[1] || $sep[0],
$self->{seconds} );
}
sub hms {
my $self = shift;
my @sep = @_[0..1];
@sep = (':') unless defined @sep;
return sprintf( "%02d%s%02d%s%02d",
$self->{hours}, $sep[0],
$self->{minutes}, $sep[1] || $sep[0],
$self->{seconds} );
}
sub hmsf {
my $self = shift;
my @sep = @_[0..1];
@sep = (':') unless defined @sep;
return sprintf( "%02d%s%02d%s%02d.%02f",
$self->{hours}, $sep[0],
$self->{minutes}, $sep[1] || $sep[0],
$self->{seconds} + ($self=>{nanoseconds} / MAX_NANOSECONDS) );
}
sub dhmsf {
my $self = shift;
my @sep = @_[0..1];
@sep = (':') unless defined @sep;
return sprintf( "%02d%s%02d%s%02d%s%02f",
$self->{days}, $sep[0],
$self->{hours}, $sep[1] || $sep[0],
$self->{minutes}, $sep[2] || $sep[1] || $sep[0],
$self->{seconds} + ($self=>{nanoseconds} / MAX_NANOSECONDS) );
}
sub DHMS {
my $self = shift;
return sprintf( "%dd %dh %dm %ds",
$self->{days},
$self->{hours},
$self->{minutes},
$self->{seconds} );
}
sub HMS {
my $self = shift;
return sprintf( "%dh %dm %ds",
$self->{hours},
$self->{minutes},
$self->{seconds} );
}
my %formats = (
'H' => sub { sprintf( '%02d', $_[0]->hours ) },
'M' => sub { sprintf( '%02d', $_[0]->minutes ) },
'N' => \&_format_nanosecs,
'r' => sub { $_[0]->strftime( '%H:%M:%S' ) },
'R' => sub { $_[0]->strftime( '%H:%M' ) },
'S' => sub { sprintf( '%02d', $_[0]->seconds ) },
'T' => sub { $_[0]->strftime( '%H:%M:%S' ) },
'%' => sub { '%' },
);
sub strftime {
my $self = shift;
# make a copy or caller's scalars get munged
my @formats = @_;
my @r;
foreach my $f (@formats)
{
# regex from Date::Format - thanks Graham!
$f =~ s/
%([%a-zA-Z])
/
$formats{$1} ? $formats{$1}->($self) : $1
/sgex;
# %3N
$f =~ s/
%(\d+)N
/
$formats{N}->($self, $1)
/sgex;
return $f unless wantarray;
push @r, $f;
}
return @r;
}
sub _format_nanosecs {
my $self = shift;
my $precision = shift;
my $ret = sprintf( "%09d", $self->nanoseconds );
return $ret unless $precision; # default = 9 digits
# rd_nanosecs might contain a fractional separator
my ( $int, $frac ) = split /[.,]/, $self->nanoseconds;
$ret .= $frac if $frac;
return substr( $ret, 0, $precision );
}
# MATHMATICAL METHODS
sub add {
$_[0]->set(days=>0, hours=>0, minutes=>0, seconds => ($_[0]->as_seconds +
$_[1]->as_seconds), nanoseconds=>0);
}
sub subtract {
$_[0]->set(days=>0, hours=>0, minutes=>0, seconds => ($_[0]->as_seconds -
$_[1]->as_seconds), nanoseconds=>0);
}
sub add_to {
my $self = shift;
my $dt = shift;
return $dt + $self->as_object();
}
sub subtract_from {
my $self = shift;
my $dt = shift;
return $dt - $self->as_object();
}
# OVERLOAD METHODS
sub _add_overload {
my ( $val1, $val2, $reversed ) = @_;
($val2, $val1) = ($val1, $val2) if $reversed;
if (UNIVERSAL::isa( $val2, 'DateTime')) {
# Return a datetime object
return $val1->add_to($val2);
} elsif (UNIVERSAL::isa( $val2, 'DateTime::Time')) {
# Return a datetime time
return $val1->add($val2);
} elsif (UNIVERSAL::isa( $val2, 'DateTime::Duration')) {
# Return a datetime time
return $val1->add( DateTime::Time->from_object($val2) );
}
return undef;
}
sub _subtract_overload {
my ( $val1, $val2, $reversed ) = @_;
($val2, $val1) = ($val1, $val2) if $reversed;
if (UNIVERSAL::isa( $val2, 'DateTime')) {
# Return a datetime object
return $val1->subtract_from($val2);
} elsif (UNIVERSAL::isa( $val2, 'DateTime::Time')) {
# Return a datetime time
return $val1->subtract($val2);
} elsif (UNIVERSAL::isa( $val2, 'DateTime::Duration')) {
# Return a datetime time
return $val1->subtract( DateTime::Time->from_object($val2) );
}
return undef;
}
sub _compare_overload {
my ( $val1, $val2, $reversed ) = @_;
croak "You can only compare DateTime::Times and DateTime::Durations"
unless (
UNIVERSAL::isa( $val1, 'DateTime::Time')
or
UNIVERSAL::isa( $val1, 'DateTime::Duration')
);
croak "You can only compare DateTime::Times and DateTime::Durations"
unless (
UNIVERSAL::isa( $val2, 'DateTime::Time')
or
UNIVERSAL::isa( $val2, 'DateTime::Duration')
);
$val1 = DateTime::Time->from_object($val1)
if UNIVERSAL::isa( $val1, 'DateTime::Duration');
$val2 = DateTime::Time->from_object($val2)
if UNIVERSAL::isa( $val2, 'DateTime::Duration');
return $val1->as_seconds <=> $val2->as_seconds;
}
# ALTERATION METHODS
sub set {
my $self = shift;
my %p = validate( @_,
{ days => { type => SCALAR, optional => 1 },
hours => { type => SCALAR, optional => 1 },
minutes => { type => SCALAR, optional => 1 },
seconds => { type => SCALAR, optional => 1 },
nanoseconds => { type => SCALAR, optional => 1 },
} );
my %old_p =
( map { $_ => $self->$_() }
qw( days hours minutes seconds nanoseconds )
);
my $new_dt = (ref $self)->new( %old_p, %p );
%$self = %$new_dt;
return $self;
}
sub truncate {
my $self = shift;
my %p = validate( @_,
{ to =>
{ regex => qr/^(?:days|hours|minutes|seconds)$/ },
},
);
my %new;
foreach my $f ( qw( days hours minutes seconds ) )
{
$new{$f} = $self->$f();
last if $p{to} eq $f;
}
my $new_dt = (ref $self)->new(%new);
%$self = %$new_dt;
return $self;
}
1;
__END__
=head1 NAME
DateTime - A date and time object
=head1 SYNOPSIS
use DateTime::Time;
$dtt = DateTime::Time->new( days => 16,
hours => 16,
minutes => 12,
seconds => 47,
nanoseconds => 500000000,
);
$dt = DateTime::Time->now;
$days = $dtt->days; # 16
$hours = $dtt->hours; # 16
$minutes = $dtt->minutes; # 12
$seconds = $dtt->seconds; # 47
$nanoseconds = $dtt->nanoseconds; # 500000000
$as_days = $dtt->as_days; # 16.6755497685185
$as_hours = $dtt->as_hours; # 400.213194444444
$as_minutes = $dtt->as_minutes; # 24012.7916666667
$as_seconds = $dtt->as_seconds; # 1440767.5
$as_nseconds = $dtt->as_nanoseconds;# 1.4407675e+15
$dhms = $dt->dhms # 16:16:12:47
$dhms = $dt->dhms('!') # 16!16!12!47
$dhms = $dt->dhms('@','!') # [EMAIL PROTECTED]
$hms = $dt->hms # 16:12:47
$hms = $dt->hms('!') # 16!12!47
$hms = $dt->hms('@','!') # [EMAIL PROTECTED]
$hmsf = $dt->hmsf # 16:12:47.5
$hmsf = $dt->hmsf('!') # 16!12!47.5
$hmsf = $dt->hmsf('@','!') # [EMAIL PROTECTED]
$dhmsf = $dt->dhmsf # 16:16:12:47.5
$dhmsf = $dt->dhmsf('!') # 16!16!12!47.5
$dhmsf = $dt->dhmsf('@','!') # [EMAIL PROTECTED]
$DHMS = $dt->DHMS # 16d 16h 12m 47s
$HMS = $dt->HMS # 16h 12m 47s
$dtt2 = $dtt + $duration_object;
$dtt2 = $dtt - $duration_object;
$dtt2 = $dtt + $dtt;
$dtt2 = $dtt - $dtt;
$dtt->set( hours => 3 ); # 03:12:47.5
$dtt->truncate( to => 'minutes' ); # 03:12:00
=head1 DESCRIPTION
DateTime::Time is the bastard love child of DateTime and
DateTime::Duration. It handles times that aren't fixed in a
timeline. Lets just say it has his mothers eyes and his father's
personality. The module is similar to DateTime::Duration in that it doesn't work with
dates, only times. However
its interface is similar to that of DateTime (without the Date parts).
To illustrate the difference between DateTime::Duration and
DateTime::Time, consider the following similar scenarios:
$dtd1 = DateTime::Duration(minutes=>2, seconds=>0);
$dtt1 = DateTime::Time (minutes=>2, seconds=>0);
$dtd2 = DateTime::Duration(minutes=>1, seconds=>47);
$dtt1 = DateTime::Time (minutes=>1, seconds=>47);
$dtd3 = $dtd1 - $dtd2;
$dtt3 = $dtt1 - $dtdt;
Before continuing, do the math in your head. Obviously there's a
13 second difference... right? Well not really. There's a difference
of one minute and -47 seconds, which we think of as 13 seconds.
DateTime::Duration uses 1 minute -47 seconds. DateTime::Time uses
13 seconds.
Why is there a difference?
Consider this: Every now and then the gods decide we need a leap second
and thus a minute gets 61 seconds. Now this event occurs at midnight on New
Years Eve. Lets use the time 00:01:47 as a starting point
(imagine that is when we finish our first glass of champagne). We know that
it takes us exactly two minutes to drink a glass, so when did we start?
Because DateTime::Duration thinks of the time it takes to drink as 2 minutes
and zero seconds, it subtracts two minutes from the time (taking into account the leap
second)
and we discover we started it at 12:59:48.
DateTime::Time on the other hand only thinks of time separated from the
timeline. To DateTime::Time, 2 minutes is always 120 seconds, come rain
hail or shine. So 'two minutes' before 00:01:47 would be 12:59:47. Of course
after a few more glasses of champage, you wont really care.
Why should I care, it's only 1 second and it hardly happens right?
Let me offer another situation. You log a highly scientific experiment as starting
at 13:34:22 and then finishing at 14:22:10. We all know that to find out how
long it took we just subtract one from the other. Using DateTime::Duration, the result
would be
48 minutes, -12 seconds.
Using DateTime::Time, the result would be 47 minutes, 48 seconds.
Of course, you could take the DateTime::Duration and do math on it and return
47 minutes, 48 seconds.
=head1 USAGE
=head2 Methods
=head3 Constructors
All constructors can die when invalid parameters are given.
=over 4
=item * new( ... )
This class method accepts parameters for each time component:
"day", "hour", "minute", "second", "nanosecond".
Additionally, it accepts a "fractional_second" parameter.
my $dtt = DateTime::Time->new( days => 25,
hours => 7,
minutes => 15,
seconds => 47,
nanoseconds => 500000000,
);
If a "fractional_second" parameter is given, then the "nanosecond"
parameter will be ignored.
When given parameters outside proper
boundaries (like a minute parameter of 72) this module will not even hiccup.
Invalid parameter types (like an array reference) will cause the
constructor to die.
All of the parameters are optional and all default to 0.
=item * from_object( object => $DateTime_Duration_Object )
This method can be used to construct a new DateTime object a
DateTime::Duration object. It coerces the Duration into the normal 60 seconds
to the minute, 60 minutes to the hour, 24 hours to the day mentality.
=item * now()
This method takes the current hour, minute and second from localtime.
=item * clone
This object method returns a replica of the given object.
=back
=head3 Accessor Methods
This class has many methods for retrieving information about an
object.
=over 4
=item * days, hours, minutes, seconds, nanoseconds, fractional_seconds
Returns the normalised values for each time resolution. For example,
calling $dtt->hours and $dtt->minutes on an object contructed with 72
minutes will return 1 hours and 12 minutes.
=item * as_days, as_hours, as_minutes, as_seconds, as_nanoseconds,
as_fractional_seconds
Returns the whole object expressed in the resolution desired. For
example, calling $dtt->as_seconds on an object constructed with 72
minutes, 12 seconds and 0.5 fractional seconds will return 4332.5
(72 * 60 + 12 + 0.5). Calling $dt->as_days on the same information will return
0.05014467593
=head3 Formatting Methods
This class has many methods for retrieving formatted information about an
object.
=over 4
=item * dhms(@optional_separators)
Returns the days, hours, minutes, and seconds, all zero-padded to two digits.
If no separators are specified, a colon (:) is used by default. If only
one separator is supplied it is used between all elements. If fewer
than three separators are supplied, the last will be used for all remaining
separations.
=item * hms(@optional_separators)
Returns the hours, minutes, and seconds, all zero-padded to two digits.
See above for note on separators
=item * hmsf(@optional_separators)
Returns the hours, minutes, and seconds including fractional seconds, all zero-padded
to two digits.
See above for note on separators
=item * dhmsf(@optional_separators)
Returns the days, hours, minutes, and seconds including fractional seconds, all
zero-padded to two digits.
See above for note on separators
=item * DHMS
Returns the days, hours, minutes, and seconds formated as '0d 0h 0m 0s'.
=item * HMS
Returns the hours, minutes, and seconds formated as '0h 0m 0s'.
=item * strftime
This method implements cutdown functionality similar to the C<strftime()>
method in C. However, if given multiple format strings, then it will
return multiple scalars, one for each format string.
See the L<strftime Specifiers|/strftime Specifiers> section for a list
of all possible format specifiers.
=back
=head3 "Set" Methods
The remaining methods provided by C<DateTime::Time>, except where otherwise
specified, return the object itself, thus making method chaining
possible.
=over 4
=item * set( .. )
This method can be used to change the components of a time. This method
accepts any parameter allowed by the
C<new()> method.
=item * truncate( to => ... )
This method allows you to reset some of the components in
the object to their "zero" values. The "to" parameter is used to
specify which values to truncate, and it may be one of "day", "hour",
"minute", or "second". For example, if
"day" is specified, then the hour, minute, second and nanosecond all become 0.
=back
=head3 Mathmatical Methods
=over 4
=item * add( $DateTime_Time_or_Duration_Object )
This method adds to the current time. If given a DateTime::Duration object,
it will first be converted into a DateTime::Time object, then added to the
current time.
=item * subtract( $DateTime_Time_or_Duration_Object )
This method subracts from the current time. If given a DateTime::Duration object,
it will first be converted into a DateTime::Time object, then subtracted from the
current time.
=item * add_to( $DateTime_Object )
This method adds the time to the DateTime object and returns a new DateTime object.
=item * subtract_from( $DateTime_Object )
This method subracts the time from the DateTime object and returns a new DateTime
object.
=back
=head3 Overloading
This module explicitly overloads the addition (+), subtraction (-),
string and numeric comparison operators. This means that the
following all do sensible things:
my $new_dtt = $dtt + $duration_obj;
my $new_dtt = $dtt + $time_obj;
my $new_dtt = $dtt - $duration_obj;
my $new_dtt = $dtt + $time_obj;
foreach my $dtt ( sort @dtts ) { ... }
Additionally, the fallback parameter is set to true, so other
derivable operators (+=, -=, etc.) will work properly. Do not expect
increment (++) or decrement (--) to do anything useful.
=head2 strftime Specifiers
The following specifiers are allowed in the format string given to the
C<strftime()> method:
=over 4
=item * %d
The days as a decimal number.
=item * %e
Like %d, the day as a decimal number, but without a leading zero.
=item * %H
The hour as a decimal number (range 00 to 23).
=item * %M
The minute as a decimal number (range 00 to 59).
=item * %N
The fractional seconds digits. Default is 9 digits (nanoseconds).
%3N milliseconds (3 digits)
%6N microseconds (6 digits)
%9N nanoseconds (9 digits)
=item * %R
The time (%H:%M). For a version including the
seconds, see %T below.
=item * %S
The second as a decimal number (range 00 to 59).
=item * %T
The time with seconds (%H:%M:%S).
=item * %%
A literal `%' character.
=back
=head1 SUPPORT
Support for this module is provided via the [EMAIL PROTECTED] email
list. See http://lists.perl.org/ for more details.
=head1 AUTHOR
Rick Measham <[EMAIL PROTECTED]>
However, most of the code is stollen from DateTime.pm by Dave Rolsky.
=head1 COPYRIGHT
Copyright (c) 2003 Rick Measham. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
Portions of the code in this distribution are derived from other
works. Please see the CREDITS file for more details.
The full text of the license can be found in the LICENSE file included
with this module.
=head1 SEE ALSO
[EMAIL PROTECTED] mailing list
http://datetime.perl.org/
=cut
