Time-Clock-1.01/000750 000765 000120 00000000000 11402056715 013441 5ustar00johnadmin000000 000000 Time-Clock-1.01/Changes000644 000765 000120 00000001337 11402056706 014745 0ustar00johnadmin000000 000000 1.01 (06.03.2010) - John Siracusa * Prevent parse failure on greater-than-nanoseconds precision. (The extra precision is discarded.) 1.00 (03.09.2010) - John Siracusa * The %i format now correctly shows 12 for 12 AM. * Removed leading zeros from the %i format. * Bumped version number to reflect API stability. 0.12 (10.16.2009) - John Siracusa * Updated eval block to avoid stomping on $@ from an outer scope. 0.11 (08.24.2006) - John Siracusa * Added the %s format specifier. * Made as_integer_seconds() part of the public API. 0.10 (06.30.2006) - John Siracusa * Initial release. Time-Clock-1.01/lib/000750 000765 000120 00000000000 11402056715 014207 5ustar00johnadmin000000 000000 Time-Clock-1.01/Makefile.PL000755 000765 000120 00000002035 11346276456 015440 0ustar00johnadmin000000 000000 require 5.006; use ExtUtils::MakeMaker; my $MM_Version = $ExtUtils::MakeMaker::VERSION; if($MM_Version =~ /_/) # dev version { $MM_Version = eval $MM_Version; die $@ if($@); } WriteMakefile(NAME => 'Time::Clock', ABSTRACT_FROM => 'lib/Time/Clock.pm', VERSION_FROM => 'lib/Time/Clock.pm', ($^O =~ /darwin/i ? (dist => { DIST_CP => 'cp' }) : ()), # Avoid Mac OS X ._* files AUTHOR => 'John Siracusa ', ($MM_Version >= 6.48 ? (MIN_PERL_VERSION => '5.6.0') : ()), ($MM_Version >= 6.31 ? (LICENSE => 'perl') : ()), ($MM_Version <= 6.44 ? () : (META_MERGE => { resources => { license => 'http://dev.perl.org/licenses/', bugtracker => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Clock', repository => 'http://rose.googlecode.com/svn/trunk/modules/Time-Clock', }, }))); Time-Clock-1.01/MANIFEST000644 000765 000120 00000000256 11402056715 014602 0ustar00johnadmin000000 000000 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) Time-Clock-1.01/META.yml000660 000765 000120 00000001405 11402056715 014715 0ustar00johnadmin000000 000000 --- #YAML:1.0 name: Time-Clock version: 1.01 abstract: Twenty-four hour clock object with nanosecond precision. author: - John Siracusa license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: perl: 5.006000 resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Clock license: http://dev.perl.org/licenses/ repository: http://rose.googlecode.com/svn/trunk/modules/Time-Clock no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Time-Clock-1.01/t/000750 000765 000120 00000000000 11402056715 013704 5ustar00johnadmin000000 000000 Time-Clock-1.01/t/basic.t000644 000765 000120 00000003272 10760063520 015161 0ustar00johnadmin000000 000000 #!/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'); Time-Clock-1.01/t/format.t000644 000765 000120 00000003500 11346276456 015401 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 28; 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'); $t->parse('12 AM'); is($t->format('%i'), '12', 'format %i 12 AM'); $t->parse('01:00:00'); is($t->format('%i'), '1', 'format %i 01:00:00'); Time-Clock-1.01/t/math.t000644 000765 000120 00000013625 11402056625 015036 0ustar00johnadmin000000 000000 #!/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.2345678901x') }; 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'); Time-Clock-1.01/t/parse.t000644 000765 000120 00000004324 11402056201 015201 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 32; 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'); ok(eval { $t->parse('7:41:50.1272602510') }, 'extended fractional seconds'); 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'); } Time-Clock-1.01/t/pod.t000644 000765 000120 00000000253 10760063520 014656 0ustar00johnadmin000000 000000 #!/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(); Time-Clock-1.01/lib/Time/000750 000765 000120 00000000000 11402056715 015105 5ustar00johnadmin000000 000000 Time-Clock-1.01/lib/Time/Clock.pm000755 000765 000120 00000041023 11402056401 016476 0ustar00johnadmin000000 000000 package Time::Clock; use strict; use Carp; our $VERSION = '1.01'; use overload ( '""' => sub { shift->as_string }, fallback => 1, ); our $Have_HiRes_Time; TRY: { local $@; eval { require Time::HiRes }; $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 == 0 ? 12 : $hour; my $ns = $self->nanosecond; $ihour =~ s/^0//; 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})\d*)? # 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})\d*)? # 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 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 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 objects automatically stringify to a user-definable format. =head1 CLASS METHODS =over 4 =item B Set the default format used by the L method for all objects of this class. Defaults to "%H:%M:%S%n". See the documentation for the L 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 Constructs a new L 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, it is equivalent to calling the L 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 object. =back =head1 OBJECT METHODS =over 4 =item B Add the time specified by PARAMS to the clock. Valid PARAMS are: =over 4 =item C An integer number of hours. =item C An integer number of minutes. =item C An integer number of seconds. =item C 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 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 is greater than 12 cannot be set to AM. Any attempt to do so will cause a fatal error. Setting a clock whose L is less than 12 to PM will cause its L 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 is less than 12, "PM" otherwise. =item B Returns the integer number of seconds since 00:00:00. =item B Returns a string representation of the clock, formatted according to the clock object's L. =item B Set the default format used by the L method for this object. Defaults to "%H:%M:%S%n". See the documentation for the L 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 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 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 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 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 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 Get or set the hour of the clock. INT must be an integer from 0 to 23. =item B Get or set the minute of the clock. INT must be an integer from 0 to 59. =item B Get or set the nanosecond of the clock. INT must be an integer from 0 to 999999999. =item B 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 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 Get or set the second of the clock. INT must be an integer from 0 to 59. =item B Subtract the time specified by PARAMS from the clock. Valid PARAMS are: =over 4 =item C An integer number of hours. =item C An integer number of minutes. =item C An integer number of seconds. =item C 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@gmail.com) =head1 LICENSE Copyright (c) 2010 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.