r18357 - in /branches/upstream/libtime-clock-perl: ./ current/ current/lib/ current/lib/Time/ current/t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Sun Apr 6 20:56:12 UTC 2008
Author: eloy
Date: Sun Apr 6 20:56:11 2008
New Revision: 18357
URL: http://svn.debian.org/wsvn/?sc=1&rev=18357
Log:
[svn-inject] Installing original source of libtime-clock-perl
Added:
branches/upstream/libtime-clock-perl/
branches/upstream/libtime-clock-perl/current/
branches/upstream/libtime-clock-perl/current/Changes
branches/upstream/libtime-clock-perl/current/MANIFEST
branches/upstream/libtime-clock-perl/current/META.yml
branches/upstream/libtime-clock-perl/current/Makefile.PL (with props)
branches/upstream/libtime-clock-perl/current/lib/
branches/upstream/libtime-clock-perl/current/lib/Time/
branches/upstream/libtime-clock-perl/current/lib/Time/Clock.pm (with props)
branches/upstream/libtime-clock-perl/current/t/
branches/upstream/libtime-clock-perl/current/t/basic.t
branches/upstream/libtime-clock-perl/current/t/format.t
branches/upstream/libtime-clock-perl/current/t/math.t
branches/upstream/libtime-clock-perl/current/t/parse.t
branches/upstream/libtime-clock-perl/current/t/pod.t
Added: branches/upstream/libtime-clock-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/Changes?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/Changes (added)
+++ branches/upstream/libtime-clock-perl/current/Changes Sun Apr 6 20:56:11 2008
@@ -1,0 +1,12 @@
+0.12 (02.01.2008) - John Siracusa <siracusa at gmail.com>
+
+ * Updated the maintainer's email address.
+
+0.11 (08.24.2006) - John Siracusa <siracusa at gmail.com>
+
+ * Added the %s format specifier.
+ * Made as_integer_seconds() part of the public API.
+
+0.10 (06.30.2006) - John Siracusa <siracusa at gmail.com>
+
+ * Initial release.
Added: branches/upstream/libtime-clock-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/MANIFEST?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/MANIFEST (added)
+++ branches/upstream/libtime-clock-perl/current/MANIFEST Sun Apr 6 20:56:11 2008
@@ -1,0 +1,10 @@
+Changes
+lib/Time/Clock.pm
+Makefile.PL
+MANIFEST
+t/basic.t
+t/format.t
+t/math.t
+t/parse.t
+t/pod.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libtime-clock-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/META.yml?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/META.yml (added)
+++ branches/upstream/libtime-clock-perl/current/META.yml Sun Apr 6 20:56:11 2008
@@ -1,0 +1,11 @@
+--- #YAML:1.0
+name: Time-Clock
+version: 0.12
+abstract: ~
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.36
+distribution_type: module
+requires:
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libtime-clock-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/Makefile.PL?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/Makefile.PL (added)
+++ branches/upstream/libtime-clock-perl/current/Makefile.PL Sun Apr 6 20:56:11 2008
@@ -1,0 +1,9 @@
+require 5.006;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(NAME => 'Time::Clock',
+ ($^O =~ /darwin/i ?
+ (dist => { DIST_CP => 'cp' }) : ()), # Avoid Mac OS X ._* files
+ PMLIBDIRS => [ 'lib' ],
+ VERSION_FROM => 'lib/Time/Clock.pm');
Propchange: branches/upstream/libtime-clock-perl/current/Makefile.PL
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libtime-clock-perl/current/lib/Time/Clock.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/lib/Time/Clock.pm?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/lib/Time/Clock.pm (added)
+++ branches/upstream/libtime-clock-perl/current/lib/Time/Clock.pm Sun Apr 6 20:56:11 2008
@@ -1,0 +1,761 @@
+package Time::Clock;
+
+use strict;
+
+use Carp;
+
+our $VERSION = '0.12';
+
+use overload
+(
+ '""' => sub { shift->as_string },
+ fallback => 1,
+);
+
+eval { require Time::HiRes };
+our $Have_HiRes_Time = $@ ? 0 : 1;
+
+# Allow an hour value of 24
+our $Allow_Hour_24 = 0;
+
+use constant NANOSECONDS_IN_A_SECOND => 1_000_000_000;
+use constant SECONDS_IN_A_MINUTE => 60;
+use constant SECONDS_IN_AN_HOUR => SECONDS_IN_A_MINUTE * 60;
+use constant SECONDS_IN_A_CLOCK => SECONDS_IN_AN_HOUR * 24;
+
+use constant DEFAULT_FORMAT => '%H:%M:%S%n';
+
+our %Default_Format;
+
+__PACKAGE__->default_format(DEFAULT_FORMAT);
+
+sub default_format
+{
+ my($invocant) = shift;
+
+ # Called as object method
+ if(ref $invocant)
+ {
+ return $invocant->{'default_format'} = shift if(@_);
+ return ref($invocant)->default_format;
+ }
+
+ # Called as class method
+ return $Default_Format{$invocant} = shift if(@_);
+ return $Default_Format{$invocant} ||= DEFAULT_FORMAT;
+}
+
+sub new
+{
+ my($class) = shift;
+
+ my $self = bless {}, $class;
+ @_ = (parse => @_) if(@_ == 1);
+ $self->init(@_);
+
+ return $self;
+}
+
+sub init
+{
+ my($self) = shift;
+
+ while(@_)
+ {
+ my $method = shift;
+ $self->$method(shift);
+ }
+}
+
+sub hour
+{
+ my($self) = shift;
+
+ if(@_)
+ {
+ my $hour = shift;
+
+ if($Allow_Hour_24)
+ {
+ croak "hour must be between 0 and 24"
+ unless(!defined $hour || ($hour >= 0 && $hour <= 24));
+ }
+ else
+ {
+ croak "hour must be between 0 and 23"
+ unless(!defined $hour || ($hour >= 0 && $hour <= 23));
+ }
+
+ return $self->{'hour'} = $hour;
+ }
+
+ return $self->{'hour'} ||= 0;
+}
+
+sub minute
+{
+ my($self) = shift;
+
+ if(@_)
+ {
+ my $minute = shift;
+
+ croak "minute must be between 0 and 59"
+ unless(!defined $minute || ($minute >= 0 && $minute <= 59));
+
+ return $self->{'minute'} = $minute;
+ }
+
+ return $self->{'minute'} ||= 0;
+}
+
+sub second
+{
+ my($self) = shift;
+
+ if(@_)
+ {
+ my $second = shift;
+
+ croak "second must be between 0 and 59"
+ unless(!defined $second || ($second >= 0 && $second <= 59));
+
+ return $self->{'second'} = $second;
+ }
+
+ return $self->{'second'} ||= 0;
+}
+
+sub nanosecond
+{
+ my($self) = shift;
+
+ if(@_)
+ {
+ my $nanosecond = shift;
+
+ croak "nanosecond must be between 0 and ", (NANOSECONDS_IN_A_SECOND - 1)
+ unless(!defined $nanosecond || ($nanosecond >= 0 && $nanosecond < NANOSECONDS_IN_A_SECOND));
+
+ return $self->{'nanosecond'} = $nanosecond;
+ }
+
+ return $self->{'nanosecond'};
+}
+
+sub ampm
+{
+ my($self) = shift;
+
+ if(@_ && defined $_[0])
+ {
+ my $ampm = shift;
+
+ if($ampm =~ /^a\.?m\.?$/i)
+ {
+ if($self->hour > 12)
+ {
+ croak "Cannot set AM/PM to AM when hour is set to ", $self->hour;
+ }
+ elsif($self->hour == 12)
+ {
+ $self->hour(0);
+ }
+
+ return 'am';
+ }
+ elsif($ampm =~ /^p\.?m\.?$/i)
+ {
+ if($self->hour < 12)
+ {
+ $self->hour($self->hour + 12);
+ }
+
+ return 'pm';
+ }
+ else { croak "AM/PM value not understood: $ampm" }
+ }
+
+ return ($self->hour >= 12) ? 'PM' : 'AM';
+}
+
+sub as_string
+{
+ my($self) = shift;
+ return $self->format($self->default_format);
+}
+
+sub format
+{
+ my($self, $format) = @_;
+
+ $format ||= ref($self)->default_format;
+
+ my $hour = $self->hour;
+ my $ihour = $hour > 12 ? ($hour - 12) : $hour;
+ my $ns = $self->nanosecond;
+
+ my %formats =
+ (
+ 'H' => sprintf('%02d', $hour),
+ 'I' => sprintf('%02d', $ihour),
+ 'i' => $ihour,
+ 'k' => $hour,
+ 'M' => sprintf('%02d', $self->minute),
+ 'S' => sprintf('%02d', $self->second),
+ 'N' => sprintf('%09d', $ns || 0),
+ 'n' => defined $ns ? sprintf('.%09d', $ns) : '',
+ 'p' => $self->ampm,
+ 'P' => lc $self->ampm,
+ 's' => $self->as_integer_seconds,
+ );
+
+ $formats{'n'} =~ s/\.?0+$//;
+
+ for($format)
+ {
+ s{ ((?:%%|[^%]+)*) %T }{$1%H:%M:%S}gx;
+
+ s/%([HIikMSsNnpP])/$formats{$1}/g;
+
+ no warnings 'uninitialized';
+ s{ ((?:%%|[^%]+)*) % ([1-9]) N }{ $1 . substr(sprintf("%09d", $ns || 0), 0, $2) }gex;
+
+ if(defined $ns)
+ {
+ s{ ((?:%%|[^%]+)*) % ([1-9]) n }{ "$1." . substr(sprintf("%09d", $ns || 0), 0, $2) }gex;
+ }
+ else
+ {
+ s{ ((?:%%|[^%]+)*) % ([1-9]) n }{$1}gx;
+ }
+
+ s/%%/%/g;
+ }
+
+ return $format;
+}
+
+sub parse
+{
+ my($self, $time) = @_;
+
+ if(my($hour, $min, $sec, $fsec, $ampm) = ($time =~
+ m{^
+ (\d\d?) # hour
+ (?::(\d\d)(?::(\d\d))?)?(?:\.(\d{0,9}))? # min? sec? nanosec?
+ (?:\s*([aApP]\.?[mM]\.?))? # am/pm
+ $
+ }x))
+ {
+ # Special case to allow times of 24:00:00, which the Postgres
+ # database considers valid (presumably in order to account for
+ # leap seconds)
+ if($hour == 24)
+ {
+ no warnings 'uninitialized';
+ if($min == 0 && $sec == 0 && $fsec == 0)
+ {
+ local $Allow_Hour_24 = 1;
+ $self->hour($hour);
+ }
+ else
+ {
+ croak "Could not parse time '$time' - an hour value of 24 is only ",
+ "allowed if minutes, seconds, and nanoseconds are all zero"
+ }
+ }
+ else { $self->hour($hour) }
+
+ $self->minute($min);
+ $self->second($sec);
+ $self->ampm($ampm);
+
+ if(defined $fsec)
+ {
+ my $len = length $fsec;
+
+ if($len < 9)
+ {
+ $fsec .= ('0' x (9 - $len));
+ }
+ elsif($len > 9)
+ {
+ $fsec = substr($fsec, 0, 9);
+ }
+ }
+
+ $self->nanosecond($fsec);
+ }
+ elsif($time eq 'now')
+ {
+ if($Have_HiRes_Time)
+ {
+ (my $fsecs = Time::HiRes::time()) =~ s/^.*\.//;
+ return $self->parse(sprintf("%d:%02d:%02d.$fsecs", (localtime(time))[2,1,0]));
+ }
+ else
+ {
+ return $self->parse(sprintf('%d:%02d:%02d', (localtime(time))[2,1,0]));
+ }
+ }
+ else
+ {
+ croak "Could not parse time '$time'";
+ }
+
+ return $self;
+}
+
+sub as_integer_seconds
+{
+ my($self) = shift;
+
+ return ($self->hour * SECONDS_IN_AN_HOUR) +
+ ($self->minute * SECONDS_IN_A_MINUTE) +
+ $self->second;
+}
+
+sub delta_as_integer_seconds
+{
+ my($self, %args) = @_;
+ return (($args{'hours'} || 0) * SECONDS_IN_AN_HOUR) +
+ (($args{'minutes'} || 0) * SECONDS_IN_A_MINUTE) +
+ ($args{'seconds'} || 0);
+}
+
+sub parse_delta
+{
+ my($self) = shift;
+
+ if(@_ == 1)
+ {
+ my $delta = shift;
+
+ if(my($hour, $min, $sec, $fsec) = ($delta =~
+ m{^
+ (\d+) # hours
+ (?::(\d+))? # minutes
+ (?::(\d+))? # seconds
+ (?:\.(\d{0,9}))? # nanoseconds
+ $
+ }x))
+ {
+ if(defined $fsec)
+ {
+ my $len = length $fsec;
+
+ if($len < 9)
+ {
+ $fsec .= ('0' x (9 - $len));
+ }
+
+ $fsec = $fsec + 0;
+ }
+
+ return
+ (
+ hours => $hour,
+ minutes => $min,
+ seconds => $sec,
+ nanoseconds => $fsec,
+ );
+ }
+ else { croak "Time delta not understood: $delta" }
+ }
+
+ return @_;
+}
+
+sub add
+{
+ my($self) = shift;
+
+ my %args = $self->parse_delta(@_);
+ my $secs = $self->as_integer_seconds + $self->delta_as_integer_seconds(%args);
+
+ if(defined $args{'nanoseconds'})
+ {
+ my $ns_arg = $args{'nanoseconds'};
+ my $nsec = $self->nanosecond || 0;
+
+ if($ns_arg + $nsec < NANOSECONDS_IN_A_SECOND)
+ {
+ $self->nanosecond($ns_arg + $nsec);
+ }
+ else
+ {
+ $secs += int(($ns_arg + $nsec) / NANOSECONDS_IN_A_SECOND);
+ $self->nanosecond(($ns_arg + $nsec) % NANOSECONDS_IN_A_SECOND);
+ }
+ }
+
+ $self->init_with_seconds($secs);
+
+ return;
+}
+
+sub subtract
+{
+ my($self) = shift;
+
+ my %args = $self->parse_delta(@_);
+ my $secs = $self->as_integer_seconds - $self->delta_as_integer_seconds(%args);
+
+ if(defined $args{'nanoseconds'})
+ {
+ my $ns_arg = $args{'nanoseconds'};
+ my $nsec = $self->nanosecond || 0;
+
+ if($nsec - $ns_arg >= 0)
+ {
+ $self->nanosecond($nsec - $ns_arg);
+ }
+ else
+ {
+ if(abs($nsec - $ns_arg) >= NANOSECONDS_IN_A_SECOND)
+ {
+ $secs -= int($ns_arg / NANOSECONDS_IN_A_SECOND);
+ }
+ else
+ {
+ $secs--;
+ }
+
+ $self->nanosecond(($nsec - $ns_arg) % NANOSECONDS_IN_A_SECOND);
+ }
+ }
+
+ if($secs < 0)
+ {
+ $secs = $secs % SECONDS_IN_A_CLOCK;
+ }
+
+ $self->init_with_seconds($secs);
+
+ return;
+}
+
+sub init_with_seconds
+{
+ my($self, $secs) = @_;
+
+ if($secs >= SECONDS_IN_A_CLOCK)
+ {
+ $secs = $secs % SECONDS_IN_A_CLOCK;
+ }
+
+ if($secs >= SECONDS_IN_AN_HOUR)
+ {
+ $self->hour(int($secs / SECONDS_IN_AN_HOUR));
+ $secs -= $self->hour * SECONDS_IN_AN_HOUR;
+ }
+ else { $self->hour(0) }
+
+ if($secs >= SECONDS_IN_A_MINUTE)
+ {
+ $self->minute(int($secs / SECONDS_IN_A_MINUTE));
+ $secs -= $self->minute * SECONDS_IN_A_MINUTE;
+ }
+ else { $self->minute(0) }
+
+ $self->second($secs);
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Time::Clock - Twenty-four hour clock object with nanosecond precision.
+
+=head1 SYNOPSIS
+
+ $t = Time::Clock->new(hour => 12, minute => 34, second => 56);
+ print $t->as_string; # 12:34:56
+
+ $t->parse('8pm');
+ print "$t"; # 20:00:00
+
+ print $t->format('%I:%M %p'); # 08:00 PM
+
+ $t->add(minutes => 15, nanoseconds => 123000000);
+ print $t->as_string; # 20:15:00.123
+
+ $t->subtract(hours => 30);
+ print $t->as_string; # 14:15:00.123
+
+ ...
+
+=head1 DESCRIPTION
+
+A L<Time::Clock> object is a twenty-four hour clock with nanosecond precision and wrap-around. It is a clock only; it has absolutely no concept of dates. Vagaries of date/time such as leap seconds and daylight savings time are unsupported.
+
+When a L<Time::Clock> object hits 23:59:59.999999999 and at least one more nanosecond is added, it will wrap around to 00:00:00.000000000. This works in reverse when time is subtracted.
+
+L<Time::Clock> objects automatically stringify to a user-definable format.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item B<default_format FORMAT>
+
+Set the default format used by the L<as_string|/as_string> method for all objects of this class. Defaults to "%H:%M:%S%n". See the documentation for the L<format|/format> method for a complete list of format specifiers.
+
+Note that this method may also be called as an object method, in which case it sets the default format for the individual object only.
+
+=back
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new PARAMS>
+
+Constructs a new L<Time::Clock> object based on PARAMS, where PARAMS are
+name/value pairs. Any object method is a valid parameter name. Example:
+
+ $t = Time::Clock->new(hour => 12, minute => 34, second => 56);
+
+If a single argument is passed to L<new|/new>, it is equivalent to calling the L<parse|/parse> method. That is, this:
+
+ $t = Time::Clock->new('12:34:56');
+
+is equivalent to this:
+
+ $t = Time::Clock->new;
+ $t->parse('12:34:56');
+
+Returns the newly constructed L<Time::Clock> object.
+
+=back
+
+=head1 OBJECT METHODS
+
+=over 4
+
+=item B<add PARAMS>
+
+Add the time specified by PARAMS to the clock. Valid PARAMS are:
+
+=over 4
+
+=item C<hours INT>
+
+An integer number of hours.
+
+=item C<minutes INT>
+
+An integer number of minutes.
+
+=item C<seconds INT>
+
+An integer number of seconds.
+
+=item C<nanoseconds INT>
+
+An integer number of nanoseconds.
+
+=back
+
+If the amount of time added is large enough, the clock will wrap around from 23:59:59.999999999 to 00:00:00.000000000 as needed.
+
+=item B<ampm AM/PM>
+
+Get or set the AM/PM attribute of the clock. Valid values of AM/PM must contain the letters "AM" or "PM" (case-insensitive), optionally followed by periods.
+
+A clock whose L<hour|/hour> is greater than 12 cannot be set to AM. Any attempt to do so will cause a fatal error.
+
+Setting a clock whose L<hour|/hour> is less than 12 to PM will cause its L<hour|/hour> to be increased by 12. Example:
+
+ $t = Time::Clock->new('8:00');
+ print $t->as_string; # 08:00:00
+
+ $t->ampm('PM');
+ print $t->as_string; # 20:00:00
+
+Return the string "AM" if the L<hour|/hour> is less than 12, "PM" otherwise.
+
+=item B<as_integer_seconds>
+
+Returns the integer number of seconds since 00:00:00.
+
+=item B<as_string>
+
+Returns a string representation of the clock, formatted according to the clock object's L<default_format|/default_format>.
+
+=item B<default_format FORMAT>
+
+Set the default format used by the L<as_string|/as_string> method for this object. Defaults to "%H:%M:%S%n". See the documentation for the L<format|/format> method for a complete list of format specifiers.
+
+Note that this method may also be called as a class method, in which case it sets the default format all objects of this class.
+
+=item B<format FORMAT>
+
+Returns the clock value formatted according to the FORMAT string containing "%"-prefixed format specifiers. Valid format specifiers are:
+
+=over 4
+
+=item C<%H>
+
+The hour as a two-digit, zero-padded integer using a 24-hour clock (range 00 to 23).
+
+=item C<%I>
+
+The hour as a two-digit, zero-padded integer using a 12-hour clock (range 01 to 12).
+
+=item C<%i>
+
+The hour as an integer using a 12-hour clock (range 1 to 12).
+
+=item C<%k>
+
+The hour as an integer using a 24-hour clock (range 0 to 23).
+
+=item C<%M>
+
+The minute as a two-digit, zero-padded integer (range 00 to 59).
+
+=item C<%n>
+
+If the clock has a non-zero L<nanosecond|/nanosecond> value, then this format produces a decimal point followed by the fractional seconds up to and including the last non-zero digit. If no L<nanosecond|/nanosecond> value is defined, or if it is zero, then this format produces an empty string. Examples:
+
+ $t = Time::Clock->new('12:34:56');
+ print $t->format('%H:%M:%S%n'); # 12:34:56
+
+ $t->nanosecond(0);
+ print $t->format('%H:%M:%S%n'); # 12:34:56
+
+ $t->nanosecond(123000000);
+ print $t->format('%H:%M:%S%n'); # 12:34:56.123
+
+=item C<%[1-9]n>
+
+If the clock has a defined L<nanosecond|/nanosecond> value, then this format produces a decimal point followed by the specified number of digits of fractional seconds (1-9). Examples:
+
+ $t = Time::Clock->new('12:34:56');
+ print $t->format('%H:%M:%S%4n'); # 12:34:56
+
+ $t->nanosecond(0);
+ print $t->format('%H:%M:%S%4n'); # 12:34:56.0000
+
+ $t->nanosecond(123000000);
+ print $t->format('%H:%M:%S%4n'); # 12:34:56.1230
+
+=item C<%N>
+
+Nanoseconds as a nine-digit, zero-padded integer (range 000000000 to 999999999)
+
+=item C<%[1-9]N>
+
+Fractional seconds as a one- to nine-digit, zero-padded integer. Examples:
+
+ $t = Time::Clock->new('12:34:56');
+ print $t->format('%H:%M:%S.%4N'); # 12:34:56.0000
+
+ $t->nanosecond(123000000);
+ print $t->format('%H:%M:%S.%6N'); # 12:34:56.123000
+
+ $t->nanosecond(123000000);
+ print $t->format('%H:%M:%S.%2N'); # 12:34:56.12
+
+=item C<%p>
+
+Either "AM" or "PM" according to the value return by the L<ampm|/ampm> method.
+
+=item C<%P>
+
+Like %p but lowercase: "am" or "pm"
+
+=item C<%S>
+
+The second as a two-digit, zero-padded integer (range 00 to 61).
+
+=item C<%s>
+
+The integer number of seconds since 00:00:00.
+
+=item C<%T>
+
+The time in 24-hour notation (%H:%M:%S).
+
+=item C<%%>
+
+A literal "%" character.
+
+=back
+
+=item B<hour INT>
+
+Get or set the hour of the clock. INT must be an integer from 0 to 23.
+
+=item B<minute INT>
+
+Get or set the minute of the clock. INT must be an integer from 0 to 59.
+
+=item B<nanosecond INT>
+
+Get or set the nanosecond of the clock. INT must be an integer from 0 to 999999999.
+
+=item B<parse STRING>
+
+Set the clock time by parsing STRING. Valid string values contain an hour with optional minutes, seconds, fractional seconds, and AM/PM string. There should be a colon (":") between hours, minutes, and seconds, and a decimal point (".") between the seconds and fractional seconds. Fractional seconds may contain up to 9 digits. The AM/PM string is case-insensitive and may have periods after each letter.
+
+The string "now" will initialize the clock object with the current (local) time. If the L<Time::HiRes> module is installed, this time will have fractional seconds.
+
+A time value with an hour of 24 and zero minutes, seconds, and nanoseconds is also accepted by this method.
+
+Here are some examples of valid time strings:
+
+ 12:34:56.123456789
+ 12:34:56.123 PM
+ 24:00
+ 8:30pm
+ 6 A.m.
+ now
+
+=item B<second INT>
+
+Get or set the second of the clock. INT must be an integer from 0 to 59.
+
+=item B<subtract PARAMS>
+
+Subtract the time specified by PARAMS from the clock. Valid PARAMS are:
+
+=over 4
+
+=item C<hours INT>
+
+An integer number of hours.
+
+=item C<minutes INT>
+
+An integer number of minutes.
+
+=item C<seconds INT>
+
+An integer number of seconds.
+
+=item C<nanoseconds INT>
+
+An integer number of nanoseconds.
+
+=back
+
+If the amount of time subtracted is large enough, the clock will wrap around from 00:00:00.000000000 to 23:59:59.999999999 as needed.
+
+=back
+
+=head1 AUTHOR
+
+John C. Siracusa (siracusa at gmail.com)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 by John C. Siracusa. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
Propchange: branches/upstream/libtime-clock-perl/current/lib/Time/Clock.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libtime-clock-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/t/basic.t?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/t/basic.t (added)
+++ branches/upstream/libtime-clock-perl/current/t/basic.t Sun Apr 6 20:56:11 2008
@@ -1,0 +1,96 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 31;
+
+BEGIN
+{
+ use_ok('Time::Clock');
+}
+
+my $t = Time::Clock->new;
+is(ref($t), 'Time::Clock', 'new()');
+
+$t = Time::Clock->new(hour => 12, minute => 34, second => 56);
+
+is($t->as_string, '12:34:56', 'as_string 1');
+is("$t", '12:34:56', 'as_string 2');
+is($t->as_integer_seconds, 45296, 'as_integer_seconds 1');
+is(Time::Clock->new('00:00:01.12345')->as_integer_seconds, 1, 'as_integer_seconds 2');
+
+$t->nanosecond(123000000);
+
+is("$t", '12:34:56.123', 'as string 3');
+
+$t = Time::Clock->new('01:02:03');
+is($t->as_string, '01:02:03', 'as_string 4');
+
+# Hour
+
+is($t->hour(0), 0, 'hour 0');
+is($t->hour(23), 23, 'hour 23');
+
+eval { $t->hour(-1) };
+ok($@, 'hour -1');
+
+eval { $t->hour(24) };
+ok($@, 'hour 24');
+
+# Minute
+
+is($t->minute(0), 0, 'minute 0');
+is($t->minute(59), 59, 'minute 59');
+
+eval { $t->minute(-1) };
+ok($@, 'minute -1');
+
+eval { $t->minute(60) };
+ok($@, 'minute 60');
+
+# Second
+
+is($t->second(0), 0, 'second 0');
+is($t->second(59), 59, 'second 59');
+
+eval { $t->second(-1) };
+ok($@, 'second -1');
+
+eval { $t->second(60) };
+ok($@, 'second 60');
+
+# Nanosecond
+
+is($t->nanosecond(0), 0, 'nanosecond 0');
+is($t->nanosecond(999_999_999), 999_999_999, 'nanosecond 999,999,999');
+
+eval { $t->nanosecond(-1) };
+ok($@, 'nanosecond -1');
+
+eval { $t->nanosecond(1_000_000_000) };
+ok($@, 'nanosecond 1,000,000,000');
+
+# AM/PM
+
+$t->hour(0);
+is($t->ampm, 'AM', 'am 1');
+$t->hour(11);
+is($t->ampm, 'AM', 'am 2');
+
+$t->hour(12);
+is($t->ampm, 'PM', 'pm 1');
+$t->hour(23);
+is($t->ampm, 'PM', 'pm 2');
+
+$t->hour(1);
+$t->ampm('pm');
+
+is($t->hour, 13, 'to pm 1');
+
+eval { $t->ampm('am') };
+ok($@, 'to am 1');
+
+$t->hour(12);
+$t->ampm('am');
+
+is($t->hour, 0, 'to am 2');
Added: branches/upstream/libtime-clock-perl/current/t/format.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/t/format.t?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/t/format.t (added)
+++ branches/upstream/libtime-clock-perl/current/t/format.t Sun Apr 6 20:56:11 2008
@@ -1,0 +1,52 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 26;
+
+use Time::Clock;
+
+my $t = Time::Clock->new;
+
+$t->parse('12:34:56.123456789');
+is($t->format('%H %k %I %i %M %S %N %n %p %P %T'), '12 12 12 12 34 56 123456789 .123456789 PM pm 12:34:56', 'format %H %I %i %M %S %N %p %P %T 1');
+
+$t->parse('13:34:56.123');
+is($t->format('%H %k %I %i %M %S %N %n %p %P %T'), '13 13 01 1 34 56 123000000 .123 PM pm 13:34:56', 'format %H %I %i %M %S %N %p %P %T 2');
+
+$t->parse('1:23:45');
+is($t->format('%k'), '1', 'format %k');
+is($t->format('%n'), '', 'format %n 1');
+is($t->format('%s'), 5025, 'format %s 1');
+
+$t->nanosecond(0);
+is($t->format('%n'), '', 'format %n 2');
+
+$t->nanosecond(123000000);
+is($t->format('%n'), '.123', 'format %n 3');
+
+$t->nanosecond(123456789);
+is($t->format('%1N'), 1, 'format %1N');
+is($t->format('%2N'), 12, 'format %2N');
+is($t->format('%3N'), 123, 'format %3N');
+is($t->format('%4N'), 1234, 'format %4N');
+is($t->format('%5N'), 12345, 'format %5N');
+is($t->format('%6N'), 123456, 'format %6N');
+is($t->format('%7N'), 1234567, 'format %7N');
+is($t->format('%8N'), 12345678, 'format %8N');
+is($t->format('%9N'), 123456789, 'format %9N');
+
+is($t->format('%1n'), '.1', 'format %1n');
+is($t->format('%2n'), '.12', 'format %2n');
+is($t->format('%3n'), '.123', 'format %3n');
+is($t->format('%4n'), '.1234', 'format %4n');
+is($t->format('%5n'), '.12345', 'format %5n');
+is($t->format('%6n'), '.123456', 'format %6n');
+is($t->format('%7n'), '.1234567', 'format %7n');
+is($t->format('%8n'), '.12345678', 'format %8n');
+is($t->format('%9n'), '.123456789', 'format %9n');
+
+$t->parse('12:34:56.123456789');
+
+$t->format('%H%%%M%%%2N');
+is($t->format('%H%%%M%%%2N'), '12%34%12', 'format %H%%%M%%%2N');
Added: branches/upstream/libtime-clock-perl/current/t/math.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/t/math.t?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/t/math.t (added)
+++ branches/upstream/libtime-clock-perl/current/t/math.t Sun Apr 6 20:56:11 2008
@@ -1,0 +1,226 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 49;
+
+use Time::Clock;
+
+my $t = Time::Clock->new;
+
+#
+# Add
+#
+
+$t->add(seconds => 1);
+is($t->as_string, '00:00:01', 'add 1 second');
+
+$t->parse('00:00:00');
+$t->add(nanoseconds => 1);
+is($t->as_string, '00:00:00.000000001', 'add 1 nanosecond');
+
+$t->parse('00:00:00');
+$t->add(minutes => 1);
+is($t->as_string, '00:01:00', 'add 1 minute');
+
+$t->parse('00:00:00');
+$t->add(hours => 1);
+is($t->as_string, '01:00:00', 'add 1 hour');
+
+# Unit wrap
+
+$t->parse('00:00:00.999999999');
+$t->add(nanoseconds => 1);
+is($t->as_string, '00:00:01', 'add 1 nanosecond - unit wrap');
+
+$t->parse('00:00:59');
+$t->add(seconds => 1);
+is($t->as_string, '00:01:00', 'add 1 second - unit wrap');
+
+$t->parse('00:59:00');
+$t->add(minutes => 1);
+is($t->as_string, '01:00:00', 'add 1 minute - unit wrap');
+
+$t->parse('23:00:00');
+$t->add(hours => 1);
+is($t->as_string, '00:00:00', 'add 1 hour - unit wrap');
+
+$t->parse('23:59:59.999999999');
+$t->add(nanoseconds => 1);
+is($t->as_string, '00:00:00', 'add 1 nanosecond - unit wrap 2');
+
+$t->parse('23:59:59');
+$t->add(seconds => 1);
+is($t->as_string, '00:00:00', 'add 1 second - unit wrap 2');
+
+$t->parse('23:59:00');
+$t->add(minutes => 1);
+is($t->as_string, '00:00:00', 'add 1 minute - unit wrap 2');
+
+$t->parse('23:00:00');
+$t->add(hours => 1);
+is($t->as_string, '00:00:00', 'add 1 hour - unit wrap 2');
+
+# Bulk units
+
+$t->parse('12:34:56.789');
+$t->add(nanoseconds => 2_000_000_123);
+is($t->as_string, '12:34:58.789000123', 'add 2,000,000,123 nanoseconds');
+
+$t->parse('01:02:03');
+$t->add(seconds => 3800);
+is($t->as_string, '02:05:23', 'add 3,800 seconds');
+
+$t->parse('01:02:03');
+$t->add(minutes => 62);
+is($t->as_string, '02:04:03', 'add 62 minutes');
+
+$t->parse('01:02:03');
+$t->add(hours => 24);
+is($t->as_string, '01:02:03', 'add 24 hours');
+
+$t->parse('01:02:03');
+$t->add(hours => 25);
+is($t->as_string, '02:02:03', 'add 25 hours');
+
+# Mixed units
+
+$t->parse('01:02:03');
+$t->add(hours => 3, minutes => 2, seconds => 1, nanoseconds => 54321);
+is($t->as_string, '04:04:04.000054321', 'add 03:02:01.000054321');
+
+$t->parse('01:02:03');
+$t->add(hours => 125, minutes => 161, seconds => 161, nanoseconds => 1_234_567_890);
+is($t->as_string, '08:45:45.23456789', 'add 125:161:162.234567890');
+
+# Strings
+
+$t->parse('01:02:03');
+$t->add('03:02:01.000054321');
+is($t->as_string, '04:04:04.000054321', 'add 03:02:01.000054321 string');
+
+$t->parse('01:02:03');
+$t->add('125:161:162.234567890');
+is($t->as_string, '08:45:45.23456789', 'add 125:161:162.234567890 string');
+
+$t->parse('01:02:03');
+$t->add('1');
+is($t->as_string, '02:02:03', 'add 1 string');
+
+$t->parse('01:02:03');
+$t->add('1:2');
+is($t->as_string, '02:04:03', 'add 1:2 string');
+
+$t->parse('01:02:03');
+$t->add('1:2:3');
+is($t->as_string, '02:04:06', 'add 1:2:3 string');
+
+$t->parse('01:02:03');
+$t->add('1:2:3.456');
+is($t->as_string, '02:04:06.456', 'add 1:2:3.456 string');
+
+eval { $t->add('125:161:162.2345678901') };
+ok($@, 'bad delta string 125:161:162.2345678901');
+
+eval { $t->add(':161:162.2345678901') };
+ok($@, 'bad delta string :161:162.2345678901');
+
+#
+# Subtract
+#
+
+$t->parse('00:00:01');
+$t->subtract(seconds => 1);
+is($t->as_string, '00:00:00', 'subtract 1 second');
+
+$t->parse('00:00:00.000000001');
+$t->subtract(nanoseconds => 1);
+is($t->as_string, '00:00:00', 'subtract 1 nanosecond');
+
+$t->parse('00:01:00');
+$t->subtract(minutes => 1);
+is($t->as_string, '00:00:00', 'subtract 1 minute');
+
+$t->parse('01:00:00');
+$t->subtract(hours => 1);
+is($t->as_string, '00:00:00', 'subtract 1 hour');
+
+# Unit wrap
+
+$t->parse('00:00:01');
+$t->subtract(nanoseconds => 1);
+is($t->as_string, '00:00:00.999999999', 'subtract 1 nanosecond - unit wrap');
+
+$t->parse('00:01:00');
+$t->subtract(seconds => 1);
+is($t->as_string, '00:00:59', 'subtract 1 second - unit wrap');
+
+$t->parse('01:00:00');
+$t->subtract(minutes => 1);
+is($t->as_string, '00:59:00', 'subtract 1 minute - unit wrap');
+
+$t->parse('00:00:00');
+$t->subtract(hours => 1);
+is($t->as_string, '23:00:00', 'subtract 1 hour - unit wrap');
+
+$t->parse('00:00:00');
+$t->subtract(nanoseconds => 1);
+is($t->as_string, '23:59:59.999999999', 'subtract 1 nanosecond - unit wrap 2');
+
+$t->parse('00:00:00');
+$t->subtract(seconds => 1);
+is($t->as_string, '23:59:59', 'subtract 1 second - unit wrap 2');
+
+$t->parse('00:00:00');
+$t->subtract(minutes => 1);
+is($t->as_string, '23:59:00', 'subtract 1 minute - unit wrap 2');
+
+$t->parse('00:00:00');
+$t->subtract(hours => 1);
+is($t->as_string, '23:00:00', 'subtract 1 hour - unit wrap 2');
+
+# Bulk units
+
+$t->parse('12:34:58.789000123');
+$t->subtract(nanoseconds => 2_000_000_123);
+is($t->as_string, '12:34:56.789', 'subtract 2,000,000,123 nanoseconds');
+
+$t->parse('02:05:23');
+$t->subtract(seconds => 3800);
+is($t->as_string, '01:02:03', 'subtract 3,800 seconds');
+
+$t->parse('02:04:03');
+$t->subtract(minutes => 62);
+is($t->as_string, '01:02:03', 'subtract 62 minutes');
+
+$t->parse('01:02:03');
+$t->subtract(hours => 24);
+is($t->as_string, '01:02:03', 'subtract 24 hours');
+
+$t->parse('02:02:03');
+$t->subtract(hours => 25);
+is($t->as_string, '01:02:03', 'subtract 25 hours');
+
+# Mixed units
+
+$t->parse('04:04:04.000054321');
+$t->subtract(hours => 3, minutes => 2, seconds => 1, nanoseconds => 54321);
+is($t->as_string, '01:02:03', 'subtract 03:02:01.000054321');
+
+$t->parse('08:45:45.234567890');
+$t->subtract(hours => 125, minutes => 161, seconds => 161, nanoseconds => 1_234_567_890);
+is($t->as_string, '01:02:03', 'subtract 125:161:162.234567890');
+
+$t->parse('08:45:45.234567890');
+for(1 .. 125) { $t->subtract(hours => 1) }
+for(1 .. 161) { $t->subtract(minutes => 1) }
+for(1 .. 161) { $t->subtract(seconds => 1) }
+is($t->as_string, '01:02:04.23456789', 'subtract 125:161:161 by 1s');
+
+$t->parse('08:45:45.234567890');
+$t->subtract(nanoseconds => 1_234_567_890);
+is($t->as_string, '08:45:44', 'subtract 0.234567890');
+
+$t->parse('24:00');
+$t->subtract(hours => 3, minutes => 2, seconds => 1, nanoseconds => 54321);
+is($t->as_string, '20:57:58.999945679', 'subtract 03:02:01.000054321');
Added: branches/upstream/libtime-clock-perl/current/t/parse.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/t/parse.t?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/t/parse.t (added)
+++ branches/upstream/libtime-clock-perl/current/t/parse.t Sun Apr 6 20:56:11 2008
@@ -1,0 +1,75 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 31;
+
+use Time::Clock;
+
+eval { require Time::HiRes };
+our $Have_HiRes_Time = $@ ? 0 : 1;
+
+my $t = Time::Clock->new;
+
+ok($t->parse('12:34:56.123456789'), 'parse 12:34:56.123456789');
+is($t->as_string, '12:34:56.123456789', 'check 12:34:56.123456789');
+
+ok($t->parse('12:34:56.123456789 pm'), 'parse 12:34:56.123456789 pm');
+is($t->as_string, '12:34:56.123456789', 'check 12:34:56.123456789 pm');
+
+ok($t->parse('12:34:56. A.m.'), 'parse 12:34:56. A.m.');
+is($t->as_string, '00:34:56', 'check 12:34:56 am');
+
+ok($t->parse('12:34:56 pm'), 'parse 12:34:56 pm');
+is($t->as_string, '12:34:56', 'check 12:34:56 pm');
+
+ok($t->parse('2:34:56 pm'), 'parse 2:34:56 pm');
+is($t->as_string, '14:34:56', 'check 14:34:56 pm');
+
+ok($t->parse('2:34 pm'), 'parse 2:34 pm');
+is($t->as_string, '14:34:00', 'check 2:34 pm');
+
+ok($t->parse('2 pm'), 'parse 2 pm');
+is($t->as_string, '14:00:00', 'check 2 pm');
+
+ok($t->parse('3pm'), 'parse 3pm');
+is($t->as_string, '15:00:00', 'check 3pm');
+
+ok($t->parse('4 p.M.'), 'parse 4 p.M.');
+is($t->as_string, '16:00:00', 'check 4 p.M.');
+
+ok($t->parse('24:00:00'), 'parse 24:00:00');
+is($t->as_string, '24:00:00', 'check 24:00:00');
+
+ok($t->parse('24:00:00 PM'), 'parse 24:00:00 PM');
+is($t->as_string, '24:00:00', 'check 24:00:00 PM');
+
+ok($t->parse('24:00'), 'parse 24:00');
+is($t->as_string, '24:00:00', 'check 24:00');
+
+eval { $t->parse('24:00:00.000000001') };
+ok($@ =~ /only allowed if/, 'parse fail 24:00:00.000000001');
+
+eval { $t->parse('24:00:01') };
+ok($@ =~ /only allowed if/, 'parse fail 24:00:01');
+
+eval { $t->parse('24:01') };
+ok($@ =~ /only allowed if/, 'parse fail 24:01');
+
+
+if($Have_HiRes_Time)
+{
+ ok($t->parse('now'), 'parse now hires');
+ ok($t->as_string =~ /^\d\d:\d\d:\d\d\.\d+$/, 'now hires');
+
+ local $Time::Clock::Have_HiRes_Time = 0;
+ ok($t->parse('now'), 'parse now lowres');
+ ok($t->as_string =~ /^\d\d:\d\d:\d\d$/, 'check now lowres');
+}
+else
+{
+ ok($t->parse('now'), 'parse now hires (skipped)');
+ ok($t->as_string =~ /^\d\d:\d\d:\d\d\.\d+$/, 'now hires (skipped)');
+ ok($t->parse('now'), 'parse now');
+ ok($t->as_string =~ /^\d\d:\d\d:\d\d$/, 'check now lowres');
+}
Added: branches/upstream/libtime-clock-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtime-clock-perl/current/t/pod.t?rev=18357&op=file
==============================================================================
--- branches/upstream/libtime-clock-perl/current/t/pod.t (added)
+++ branches/upstream/libtime-clock-perl/current/t/pod.t Sun Apr 6 20:56:11 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More;
+
+eval 'use Test::Pod 1.00';
+
+plan(skip_all => 'Test::Pod 1.00 required for testing POD') if($@);
+
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list