Time-Duration-1.1/0000755000175000017500000000000012126665210012155 5ustar aviaviTime-Duration-1.1/t/0000755000175000017500000000000012126665210012420 5ustar aviaviTime-Duration-1.1/t/02_pod.t0000644000175000017500000000006312124623276013673 0ustar aviaviuse Test::More; use Test::Pod; all_pod_files_ok(); Time-Duration-1.1/t/03_pod_cover.t0000644000175000017500000000054012124623276015072 0ustar aviaviuse Test::Pod::Coverage tests=>1; pod_coverage_ok( "Time::Duration", # This module has a number of private methods whose names do not begin with # _. This is kind of unfortunate, but it's too late now to change things, # so I will just manually omit them. { also_private => [qw/^(?:interval|interval_exact)$/], }, "Time::Duration is covered" ); Time-Duration-1.1/t/04_tdur_ms.t0000644000175000017500000000407412126663661014602 0ustar aviaviuse strict; use Test; my @them; BEGIN { plan('tests' => 20) }; BEGIN { print "# Perl version $] under $^O\n" } use Time::Duration; ok 1; print "# Time::Duration version $Time::Duration::VERSION\n"; use constant MINUTE => 60; use constant HOUR => 3600; use constant DAY => 24 * HOUR; use constant YEAR => 365 * DAY; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Millisecond mode disabled...\n"; ok( sub{duration(1.001)}, '1 second'); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Basic millisecond tests...\n"; $Time::Duration::MILLISECOND = 1; ok( sub{duration(1.001)}, '1 second and 1 millisecond'); ok( sub{duration(1.021)}, '1 second and 21 milliseconds'); ok( sub{later( 2.001)}, '2 seconds and 1 millisecond later'); ok( sub{later( 2.021)}, '2 seconds and 21 milliseconds later'); ok( sub{earlier(2.001)}, '2 seconds and 1 millisecond earlier'); ok( sub{earlier(2.021)}, '2 seconds and 21 milliseconds earlier'); ok( sub{ago( 2.001)}, '2 seconds and 1 millisecond ago'); ok( sub{ago( 2.021)}, '2 seconds and 21 milliseconds ago'); ok( sub{from_now(2.001)}, '2 seconds and 1 millisecond from now'); ok( sub{from_now(2.021)}, '2 seconds and 21 milliseconds from now'); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Advanced millisecond tests...\n"; my $v; #scratch var $v = 61.02; ok(sub {later( $v )}, '1 minute and 1 second later'); ok(sub {later( $v, 3)}, '1 minute, 1 second, and 20 milliseconds later'); ok(sub {later_exact( $v )}, '1 minute, 1 second, and 20 milliseconds later'); $v = DAY + - HOUR + -28.802 + YEAR; ok(sub {later( $v )}, '1 year and 23 hours later'); ok(sub {later( $v, 3)}, '1 year and 23 hours later'); ok(sub {later_exact( $v )}, '1 year, 22 hours, 59 minutes, 31 seconds, and 198 milliseconds later'); #~~~~~~~~ print "# Some tests of concise() ...\n"; ok( sub{concise duration( 1.021)}, '1s21ms'); ok( sub{concise duration( -1.021)}, '1s21ms'); print "# Done with all of ", __FILE__, "\n"; Time-Duration-1.1/t/01_tdur.t0000644000175000017500000002213312124623276014070 0ustar aviavi# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' use strict; use Test; my @them; BEGIN { plan('tests' => 135) }; BEGIN { print "# Perl version $] under $^O\n" } use Time::Duration; ok 1; print "# Time::Duration version $Time::Duration::VERSION\n"; use constant MINUTE => 60; use constant HOUR => 3600; use constant DAY => 24 * HOUR; use constant YEAR => 365 * DAY; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Basic tests...\n"; ok( sub{duration( 0)}, '0 seconds'); ok( sub{duration( 1)}, '1 second'); ok( sub{duration( -1)}, '1 second'); ok( sub{duration( 2)}, '2 seconds'); ok( sub{duration( -2)}, '2 seconds'); ok( sub{later( 0)}, 'right then'); ok( sub{later( 2)}, '2 seconds later'); ok( sub{later( -2)}, '2 seconds earlier'); ok( sub{earlier( 0)}, 'right then'); ok( sub{earlier( 2)}, '2 seconds earlier'); ok( sub{earlier(-2)}, '2 seconds later'); ok( sub{ago( 0)}, 'right now'); ok( sub{ago( 2)}, '2 seconds ago'); ok( sub{ago( -2)}, '2 seconds from now'); ok( sub{from_now( 0)}, 'right now'); ok( sub{from_now( 2)}, '2 seconds from now'); ok( sub{from_now(-2)}, '2 seconds ago'); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Advanced tests...\n"; my $v; #scratch var $v = 0; ok(sub {later( $v )}, 'right then'); ok(sub {later( $v, 3)}, 'right then'); ok(sub {later_exact( $v )}, 'right then'); $v = 1; ok(sub {later( $v )}, '1 second later'); ok(sub {later( $v, 3)}, '1 second later'); ok(sub {later_exact( $v )}, '1 second later'); $v = 30; ok(sub {later( $v )}, '30 seconds later'); ok(sub {later( $v, 3)}, '30 seconds later'); ok(sub {later_exact( $v )}, '30 seconds later'); $v = 46; ok(sub {later( $v )}, '46 seconds later'); ok(sub {later( $v, 3)}, '46 seconds later'); ok(sub {later_exact( $v )}, '46 seconds later'); $v = 59; ok(sub {later( $v )}, '59 seconds later'); ok(sub {later( $v, 3)}, '59 seconds later'); ok(sub {later_exact( $v )}, '59 seconds later'); $v = 61; ok(sub {later( $v )}, '1 minute and 1 second later'); ok(sub {later( $v, 3)}, '1 minute and 1 second later'); ok(sub {later_exact( $v )}, '1 minute and 1 second later'); $v = 3599; ok(sub {later( $v )}, '59 minutes and 59 seconds later'); ok(sub {later( $v, 3)}, '59 minutes and 59 seconds later'); ok(sub {later_exact( $v )}, '59 minutes and 59 seconds later'); $v = 3600; ok(sub {later( $v )}, '1 hour later'); ok(sub {later( $v, 3)}, '1 hour later'); ok(sub {later_exact( $v )}, '1 hour later'); $v = 3601; ok(sub {later( $v )}, '1 hour and 1 second later'); ok(sub {later( $v, 3)}, '1 hour and 1 second later'); ok(sub {later_exact( $v )}, '1 hour and 1 second later'); $v = 3630; ok(sub {later( $v )}, '1 hour and 30 seconds later'); ok(sub {later( $v, 3)}, '1 hour and 30 seconds later'); ok(sub {later_exact( $v )}, '1 hour and 30 seconds later'); $v = 3800; ok(sub {later( $v )}, '1 hour and 3 minutes later'); ok(sub {later( $v, 3)}, '1 hour, 3 minutes, and 20 seconds later'); ok(sub {later_exact( $v )}, '1 hour, 3 minutes, and 20 seconds later'); $v = 3820; ok(sub {later( $v )}, '1 hour and 4 minutes later'); ok(sub {later( $v, 3)}, '1 hour, 3 minutes, and 40 seconds later'); ok(sub {later_exact( $v )}, '1 hour, 3 minutes, and 40 seconds later'); $v = DAY + - HOUR + -28; ok(sub {later( $v )}, '23 hours later'); ok(sub {later( $v, 3)}, '22 hours, 59 minutes, and 32 seconds later'); ok(sub {later_exact( $v )}, '22 hours, 59 minutes, and 32 seconds later'); $v = DAY + - HOUR + MINUTE; ok(sub {later( $v )}, '23 hours and 1 minute later'); ok(sub {later( $v, 3)}, '23 hours and 1 minute later'); ok(sub {later_exact( $v )}, '23 hours and 1 minute later'); $v = DAY + - HOUR + 29 * MINUTE + 1; ok(sub {later( $v )}, '23 hours and 29 minutes later'); ok(sub {later( $v, 3)}, '23 hours, 29 minutes, and 1 second later'); ok(sub {later_exact( $v )}, '23 hours, 29 minutes, and 1 second later'); $v = DAY + - HOUR + 29 * MINUTE + 31; ok(sub {later( $v )}, '23 hours and 30 minutes later'); ok(sub {later( $v, 3)}, '23 hours, 29 minutes, and 31 seconds later'); ok(sub {later_exact( $v )}, '23 hours, 29 minutes, and 31 seconds later'); $v = DAY + - HOUR + 30 * MINUTE + 31; ok(sub {later( $v )}, '23 hours and 31 minutes later'); ok(sub {later( $v, 3)}, '23 hours, 30 minutes, and 31 seconds later'); ok(sub {later_exact( $v )}, '23 hours, 30 minutes, and 31 seconds later'); $v = DAY + - HOUR + -28 + YEAR; ok(sub {later( $v )}, '1 year and 23 hours later'); ok(sub {later( $v, 3)}, '1 year and 23 hours later'); ok(sub {later_exact( $v )}, '1 year, 22 hours, 59 minutes, and 32 seconds later'); $v = DAY + - HOUR + MINUTE + YEAR; ok(sub {later( $v )}, '1 year and 23 hours later'); ok(sub {later( $v, 3)}, '1 year, 23 hours, and 1 minute later'); ok(sub {later_exact( $v )}, '1 year, 23 hours, and 1 minute later'); $v = DAY + - HOUR + 29 * MINUTE + 1 + YEAR; ok(sub {later( $v )}, '1 year and 23 hours later'); ok(sub {later( $v, 3)}, '1 year, 23 hours, and 29 minutes later'); ok(sub {later_exact( $v )}, '1 year, 23 hours, 29 minutes, and 1 second later'); $v = DAY + - HOUR + 29 * MINUTE + 31 + YEAR; ok(sub {later( $v )}, '1 year and 23 hours later'); ok(sub {later( $v, 3)}, '1 year, 23 hours, and 30 minutes later'); ok(sub {later_exact( $v )}, '1 year, 23 hours, 29 minutes, and 31 seconds later'); $v = YEAR + 2 * HOUR + -1; ok(sub {later( $v )}, '1 year and 2 hours later'); ok(sub {later( $v, 3)}, '1 year and 2 hours later'); ok(sub {later_exact( $v )}, '1 year, 1 hour, 59 minutes, and 59 seconds later'); $v = YEAR + 2 * HOUR + 59; ok(sub {later( $v )}, '1 year and 2 hours later'); ok(sub {later( $v, 3)}, '1 year, 2 hours, and 59 seconds later'); ok(sub {later_exact( $v )}, '1 year, 2 hours, and 59 seconds later'); $v = YEAR + DAY + 2 * HOUR + -1; ok(sub {later( $v )}, '1 year and 1 day later'); ok(sub {later( $v, 3)}, '1 year, 1 day, and 2 hours later'); ok(sub {later_exact( $v )}, '1 year, 1 day, 1 hour, 59 minutes, and 59 seconds later'); $v = YEAR + DAY + 2 * HOUR + 59; ok(sub {later( $v )}, '1 year and 1 day later'); ok(sub {later( $v, 3)}, '1 year, 1 day, and 2 hours later'); ok(sub {later_exact( $v )}, '1 year, 1 day, 2 hours, and 59 seconds later'); $v = YEAR + - DAY + - 1; ok(sub {later( $v )}, '364 days later'); ok(sub {later( $v, 3)}, '364 days later'); ok(sub {later_exact( $v )}, '363 days, 23 hours, 59 minutes, and 59 seconds later'); $v = YEAR + - 1; ok(sub {later( $v )}, '1 year later'); ok(sub {later( $v, 3)}, '1 year later'); ok(sub {later_exact( $v )}, '364 days, 23 hours, 59 minutes, and 59 seconds later'); print "# And an advanced one to put duration thru its paces...\n"; $v = YEAR + DAY + 2 * HOUR + 59; ok(sub {duration( $v )}, '1 year and 1 day'); ok(sub {duration( $v, 3)}, '1 year, 1 day, and 2 hours'); ok(sub {duration_exact( $v )}, '1 year, 1 day, 2 hours, and 59 seconds'); ok(sub {duration( -$v )}, '1 year and 1 day'); ok(sub {duration( -$v, 3)}, '1 year, 1 day, and 2 hours'); ok(sub {duration_exact(-$v )}, '1 year, 1 day, 2 hours, and 59 seconds'); #~~~~~~~~ print "# Some tests of concise() ...\n"; ok( sub{concise duration( 0)}, '0s'); ok( sub{concise duration( 1)}, '1s'); ok( sub{concise duration( -1)}, '1s'); ok( sub{concise duration( 2)}, '2s'); ok( sub{concise duration( -2)}, '2s'); ok( sub{concise later( 0)}, 'right then'); ok( sub{concise later( 2)}, '2s later'); ok( sub{concise later( -2)}, '2s earlier'); ok( sub{concise earlier( 0)}, 'right then'); ok( sub{concise earlier( 2)}, '2s earlier'); ok( sub{concise earlier(-2)}, '2s later'); ok( sub{concise ago( 0)}, 'right now'); ok( sub{concise ago( 2)}, '2s ago'); ok( sub{concise ago( -2)}, '2s from now'); ok( sub{concise from_now( 0)}, 'right now'); ok( sub{concise from_now( 2)}, '2s from now'); ok( sub{concise from_now(-2)}, '2s ago'); $v = YEAR + DAY + 2 * HOUR + -1; ok(sub {concise later( $v )}, '1y1d later'); ok(sub {concise later( $v, 3)}, '1y1d2h later'); ok(sub {concise later_exact( $v )}, '1y1d1h59m59s later'); $v = YEAR + DAY + 2 * HOUR + 59; ok(sub {concise later( $v )}, '1y1d later'); ok(sub {concise later( $v, 3)}, '1y1d2h later'); ok(sub {concise later_exact( $v )}, '1y1d2h59s later'); $v = YEAR + - DAY + - 1; ok(sub {concise later( $v )}, '364d later'); ok(sub {concise later( $v, 3)}, '364d later'); ok(sub {concise later_exact( $v )}, '363d23h59m59s later'); $v = YEAR + - 1; ok(sub {concise later( $v )}, '1y later'); ok(sub {concise later( $v, 3)}, '1y later'); ok(sub {concise later_exact( $v )}, '364d23h59m59s later'); # That's it. print "# And one for the road.\n"; ok 1; print "# Done with of ", __FILE__, "\n"; Time-Duration-1.1/README0000644000175000017500000002053512124623276013046 0ustar aviaviREADME for Time::Duration NAME Time::Duration -- rounded or exact English expression of durations SYNOPSIS Example use in a program that ends by noting its runtime: my $start_time = time(); use Time::Duration; # then things that take all that time, and then ends: print "Runtime ", duration(time() - $start_time), ".\n"; Example use in a program that reports age of a file: use Time::Duration; my $file = 'that_file'; my $age = $^T - (stat($file))[9]; # 9 = modtime print "$file was modified ", ago($age); DESCRIPTION This module provides functions for expressing durations in rounded or exact terms. In the first example in the Synopsis, using duration($interval_seconds): If the `time() - $start_time' is 3 seconds, this prints "Runtime: 3 seconds.". If it's 0 seconds, it's "Runtime: 0 seconds.". If it's 1 second, it's "Runtime: 1 second.". If it's 125 seconds, you get "Runtime: 2 minutes and 5 seconds.". If it's 3820 seconds (which is exactly 1h, 3m, 40s), you get it rounded to fit within two expressed units: "Runtime: 1 hour and 4 minutes.". Using duration_exact instead would return "Runtime: 1 hour, 3 minutes, and 40 seconds". In the second example in the Synopsis, using ago($interval_seconds): If the $age is 3 seconds, this prints "*file* was modified 3 seconds ago". If it's 0 seconds, it's "*file* was modified just now", as a special case. If it's 1 second, it's "from 1 second ago". If it's 125 seconds, you get "*file* was modified 2 minutes and 5 seconds ago". If it's 3820 seconds (which is exactly 1h, 3m, 40s), you get it rounded to fit within two expressed units: "*file* was modified 1 hour and 4 minutes ago". Using ago_exact instead would return "*file* was modified 1 hour, 3 minutes, and 40 seconds ago". And if the file's modtime is, surprisingly, three seconds into the future, $age is -3, and you'll get the equally and appropriately surprising "*file* was modified 3 seconds from now." FUNCTIONS This module provides all the following functions, which are all exported by default when you call `use Time::Duration;'. duration($seconds) duration($seconds, $precision) Returns English text expressing the approximate time duration of abs($seconds), with at most `$precision || 2' expressed units. (That is, duration($seconds) is the same as duration($seconds,2).) For example, duration(120) or duration(-120) is "2 minutes". And duration(0) is "0 seconds". The precision figure means that no more than that many units will be used in expressing the time duration. For example, 31,629,659 seconds is a duration of *exactly* 1 year, 1 day, 2 hours, and 59 seconds (assuming 1 year = exactly 365 days, as we do assume in this module). However, if you wanted an approximation of this to at most two expressed (i.e., nonzero) units, it would round it and truncate it to "1 year and 1 day". Max of 3 expressed units would get you "1 year, 1 day, and 2 hours". Max of 4 expressed units would get you "1 year, 1 day, 2 hours, and 59 seconds", which happens to be exactly true. Max of 5 (or more) expressed units would get you the same, since there are only four nonzero units possible in for that duration. duration_exact($seconds) Same as duration($seconds), except that the returned value is an exact (unrounded) expression of $seconds. For example, duration_exact(31629659) returns "1 year, 1 day, 2 hours, and 59 seconds later", which is *exactly* true. ago($seconds) ago($seconds, $precision) For a positive value of seconds, this prints the same as `duration($seconds, [$precision]) . ' ago''. For example, ago(120) is "2 minutes ago". For a negative value of seconds, this prints the same as `duration($seconds, [$precision]) . ' from now''. For example, ago(-120) is "2 minutes from now". As a special case, ago(0) returns "right now". ago_exact($seconds) Same as ago($seconds), except that the returned value is an exact (unrounded) expression of $seconds. from_now($seconds) from_now($seconds, $precision) from_now_exact($seconds) The same as ago(-$seconds), ago(-$seconds, $precision), ago_exact(- $seconds). For example, from_now(120) is "2 minutes from now". later($seconds) later($seconds, $precision) For a positive value of seconds, this prints the same as `duration($seconds, [$precision]) . ' later''. For example, ago(120) is "2 minutes later". For a negative value of seconds, this prints the same as `duration($seconds, [$precision]) . ' earlier''. For example, later(- 120) is "2 minutes earlier". As a special case, later(0) returns "right then". later_exact($seconds) Same as later($seconds), except that the returned value is an exact (unrounded) expression of $seconds. earlier($seconds) earlier($seconds, $precision) earlier_exact($seconds) The same as later(-$seconds), later(-$seconds, $precision), later_exact(-$seconds). For example, earlier(120) is "2 minutes earlier". I18N/L10N NOTES Little of the internals of this module are English-specific. See source and/or contact me if you're interested in making a localized version for some other language than English. BACKSTORY I wrote the basic `ago()' function for use in Infobot (`http://www.infobot.org'), because I was tired of this sort of response from the Purl Infobot: me> Purl, seen Woozle? Woozle was last seen on #perl 20 days, 7 hours, 32 minutes and 40 seconds ago, saying: Wuzzle! I figured if it was 20 days ago, I don't care about the seconds. So once I had written `ago()', I abstracted the code a bit and got all the other functions. CAVEAT This module calls a durational "year" an interval of exactly 365 days of exactly 24 hours each, with no provision for leap years or monkey business with 23/25 hour days (much less leap seconds!). But since the main work of this module is approximation, that shouldn't be a great problem for most purposes. SEE ALSO Date::Interval, which is similarly named, but does something rather different. *Star Trek: The Next Generation* (1987-1994), where the character Data would express time durations like "1 year, 20 days, 22 hours, 59 minutes, and 35 seconds" instead of rounding to "1 year and 21 days". This is because no-one ever told him to use Time::Duration. COPYRIGHT AND DISCLAIMER Copyright 2006, Sean M. Burke `sburke@cpan.org', all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. AUTHOR Original Author: Sean M. Burke, `sburke@cpan.org' Maintainer: Avi Finkel, `avi@finkel.org' PREREQUISITES This suite requires Perl 5. Time::Duration doesn't use any nonstandard modules. INSTALLATION You install Time::Duration, as you would install any perl module library, by running these commands: perl Makefile.PL make make test make install If you want to install a private copy of Time::Duration in your home directory, then you should try to produce the initial Makefile with something like this command: perl Makefile.PL LIB=~/perl See perldoc perlmodinstall for more information. DOCUMENTATION POD-format documentation is included in Duration.pm. POD is readable with the 'perldoc' utility. See ChangeLog for recent changes. MACPERL INSTALLATION NOTES Don't bother with the makefiles. Just make a Time directory in your MacPerl site_lib or lib directory, and move Duration.pm into there. SUPPORT Questions, bug reports, useful code bits, and suggestions for Time::Duration should just be sent to me at avi@finkel.org AVAILABILITY The latest version of Time::Duration is available from the Comprehensive Perl Archive Network (CPAN). Visit to find a CPAN site near you. Time-Duration-1.1/inc/0000755000175000017500000000000012126665210012726 5ustar aviaviTime-Duration-1.1/inc/Module/0000755000175000017500000000000012126665210014153 5ustar aviaviTime-Duration-1.1/inc/Module/Install.pm0000644000175000017500000001761112124623276016131 0ustar aviavi#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.67'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die << "END_DIE"; Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; Time-Duration-1.1/inc/Module/Install/0000755000175000017500000000000012126665210015561 5ustar aviaviTime-Duration-1.1/inc/Module/Install/Fetch.pm0000644000175000017500000000463012124623276017157 0ustar aviavi#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Time-Duration-1.1/inc/Module/Install/Win32.pm0000644000175000017500000000341612124623276017031 0ustar aviavi#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } } 1; Time-Duration-1.1/inc/Module/Install/WriteAll.pm0000644000175000017500000000162412124623276017651 0ustar aviavi#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{'PL_FILES'} ) { $self->makemaker_args( PL_FILES => {} ); } if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; Time-Duration-1.1/inc/Module/Install/Metadata.pm0000644000175000017500000002152712124623276017652 0ustar aviavi#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } # configure_requires is currently a null-op sub configure_requires { 1 } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'gpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; } $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; Time-Duration-1.1/inc/Module/Install/Include.pm0000644000175000017500000000101412124623276017502 0ustar aviavi#line 1 package Module::Install::Include; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Time-Duration-1.1/inc/Module/Install/Can.pm0000644000175000017500000000337412124623276016633 0ustar aviavi#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 Time-Duration-1.1/inc/Module/Install/Base.pm0000644000175000017500000000203512124623276016775 0ustar aviavi#line 1 package Module::Install::Base; $VERSION = '0.67'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 Time-Duration-1.1/inc/Module/Install/Makefile.pm0000644000175000017500000001351112124623276017641 0ustar aviavi#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } require File::Find; %test_dir = (); File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->build_requires, $self->requires) ); # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 363 Time-Duration-1.1/inc/Module/Install/AutoInstall.pm0000644000175000017500000000227212124623276020365 0ustar aviavi#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Time-Duration-1.1/inc/Module/AutoInstall.pm0000644000175000017500000005077212124623276016767 0ustar aviavi#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. if ( defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } $UnderCPAN = _check_lock(); # check for $UnderCPAN if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { print <<'END_MESSAGE'; *** Since we're running under CPANPLUS, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } _load_cpan(); # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if defined( _version_check( _load($class), $ver ) ); # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION; require CPAN; if ( $CPAN::HandleConfig::VERSION ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison sub _version_check { my ( $cur, $min ) = @_; return unless defined $cur; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return ( ( version->new($cur) >= version->new($min) ) ? $cur : undef ); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) ? $cur : undef ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return ( $cur >= $min ? $cur : undef ); } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return << "."; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions . } 1; __END__ #line 1003 Time-Duration-1.1/META.yml0000644000175000017500000000064712124623276013441 0ustar aviavi--- abstract: rounded or exact English expression of durations author: ', Sean M. Burke C, all rights' build_requires: Test::Pod: 0 Test::Pod::Coverage: 0 distribution_type: module generated_by: Module::Install version 0.67 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Time-Duration no_index: directory: - inc - t version: 1.06 Time-Duration-1.1/MANIFEST0000644000175000017500000000070112124627164013310 0ustar aviaviChangeLog Duration.pm inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm Makefile.PL MANIFEST This list of files META.yml README t/01_tdur.t t/02_pod.t t/03_pod_cover.t t/04_tdur_ms.t Time-Duration-1.1/Makefile.PL0000644000175000017500000000024712124623276014136 0ustar aviaviuse inc::Module::Install; name 'Time-Duration'; all_from 'Duration.pm'; build_requires('Test::Pod'); build_requires('Test::Pod::Coverage'); auto_install; WriteAll; Time-Duration-1.1/ChangeLog0000644000175000017500000000110412126665074013733 0ustar aviaviRevision history for Perl extension Time::Duration 2013-04-02 Avi Finkel avi@finkel.org * Release 1.1 -- Adding millisecond support. 2007-08-18 Avi Finkel avi@finkel.org * Release 1.06 -- Fixing Makefile 2006-07-23 Avi Finkel avi@finkel.org * Release 1.04 -- Reorganizing tests 2006-02-28 Avi Finkel avi@finkel.org * Release 1.03 -- Updating new maintainer information. 2002-10-08 Sean M. Burke sburke@cpan.org * Release 1.02 -- added concise(). 2001-10-25 Sean M. Burke sburke@netadventure.net * Release 1.01 -- first release version. Time-Duration-1.1/Duration.pm0000644000175000017500000003611312126665046014313 0ustar aviavi package Time::Duration; # POD is at the end. $VERSION = '1.1'; require Exporter; @ISA = ('Exporter'); @EXPORT = qw( later later_exact earlier earlier_exact ago ago_exact from_now from_now_exact duration duration_exact concise ); @EXPORT_OK = ('interval', @EXPORT); use strict; use constant DEBUG => 0; our $MILLISECOND = 0; # ALL SUBS ARE PURE FUNCTIONS #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub concise ($) { my $string = $_[0]; DEBUG and print "in : $string\n"; $string =~ tr/,//d; $string =~ s/\band\b//; $string =~ s/\b(year|day|hour|minute|second)s?\b/substr($1,0,1)/eg; $string =~ s/\b(millisecond)s?\b/ms/g; $string =~ s/\s*(\d+)\s*/$1/g; return $string; } sub later { interval( $_[0], $_[1], ' earlier', ' later', 'right then'); } sub later_exact { interval_exact($_[0], $_[1], ' earlier', ' later', 'right then'); } sub earlier { interval( $_[0], $_[1], ' later', ' earlier', 'right then'); } sub earlier_exact { interval_exact($_[0], $_[1], ' later', ' earlier', 'right then'); } sub ago { interval( $_[0], $_[1], ' from now', ' ago', 'right now'); } sub ago_exact { interval_exact($_[0], $_[1], ' from now', ' ago', 'right now'); } sub from_now { interval( $_[0], $_[1], ' ago', ' from now', 'right now'); } sub from_now_exact { interval_exact($_[0], $_[1], ' ago', ' from now', 'right now'); } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub duration_exact { my $span = $_[0]; # interval in seconds my $precision = int($_[1] || 0) || 2; # precision (default: 2) return '0 seconds' unless $span; _render('', _separate(abs $span)); } sub duration { my $span = $_[0]; # interval in seconds my $precision = int($_[1] || 0) || 2; # precision (default: 2) return '0 seconds' unless $span; _render('', _approximate($precision, _separate(abs $span))); } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub interval_exact { my $span = $_[0]; # interval, in seconds # precision is ignored my $direction = ($span < 0) ? $_[2] # what a neg number gets : ($span > 0) ? $_[3] # what a pos number gets : return $_[4]; # what zero gets _render($direction, _separate($span)); } sub interval { my $span = $_[0]; # interval, in seconds my $precision = int($_[1] || 0) || 2; # precision (default: 2) my $direction = ($span < 0) ? $_[2] # what a neg number gets : ($span > 0) ? $_[3] # what a pos number gets : return $_[4]; # what zero gets _render($direction, _approximate($precision, _separate($span))); } #~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~# # # The actual figuring is below here use constant MINUTE => 60; use constant HOUR => 3600; use constant DAY => 24 * HOUR; use constant YEAR => 365 * DAY; sub _separate { # Breakdown of seconds into units, starting with the most significant my $remainder = abs $_[0]; # remainder my $this; # scratch my @wheel; # retval # Years: $this = int($remainder / (365 * 24 * 60 * 60)); push @wheel, ['year', $this, 1_000_000_000]; $remainder -= $this * (365 * 24 * 60 * 60); # Days: $this = int($remainder / (24 * 60 * 60)); push @wheel, ['day', $this, 365]; $remainder -= $this * (24 * 60 * 60); # Hours: $this = int($remainder / (60 * 60)); push @wheel, ['hour', $this, 24]; $remainder -= $this * (60 * 60); # Minutes: $this = int($remainder / 60); push @wheel, ['minute', $this, 60]; $remainder -= $this * 60; push @wheel, ['second', int($remainder), 60]; # Thanks to Steven Haryanto (http://search.cpan.org/~sharyanto/) for the basis of this change. if ($MILLISECOND) { $remainder -= int($remainder); push @wheel, ['millisecond', sprintf("%0.f", $remainder * 1000), 1000]; } return @wheel; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub _approximate { # Now nudge the wheels into an acceptably (im)precise configuration my($precision, @wheel) = @_; Fix: { # Constraints for leaving this block: # 1) number of nonzero wheels must be <= $precision # 2) no wheels can be improperly expressed (like having "60" for mins) my $nonzero_count = 0; my $improperly_expressed; DEBUG and print join ' ', '#', (map "${$_}[1] ${$_}[0]", @wheel), "\n"; for(my $i = 0; $i < @wheel; $i++) { my $this = $wheel[$i]; next if $this->[1] == 0; # Zeros require no attention. ++$nonzero_count; next if $i == 0; # the years wheel is never improper or over any limit; skip if($nonzero_count > $precision) { # This is one nonzero wheel too many! DEBUG and print '', $this->[0], " is one nonzero too many!\n"; # Incr previous wheel if we're big enough: if($this->[1] >= ($this->[-1] / 2)) { DEBUG and printf "incrementing %s from %s to %s\n", $wheel[$i-1][0], $wheel[$i-1][1], 1 + $wheel[$i-1][1], ; ++$wheel[$i-1][1]; } # Reset this and subsequent wheels to 0: for(my $j = $i; $j < @wheel; $j++) { $wheel[$j][1] = 0 } redo Fix; # Start over. } elsif($this->[1] >= $this->[-1]) { # It's an improperly expressed wheel. (Like "60" on the mins wheel) $improperly_expressed = $i; DEBUG and print '', $this->[0], ' (', $this->[1], ") is improper!\n"; } } if(defined $improperly_expressed) { # Only fix the least-significant improperly expressed wheel (at a time). DEBUG and printf "incrementing %s from %s to %s\n", $wheel[$improperly_expressed-1][0], $wheel[$improperly_expressed-1][1], 1 + $wheel[$improperly_expressed-1][1], ; ++$wheel[ $improperly_expressed - 1][1]; $wheel[ $improperly_expressed][1] = 0; # We never have a "150" in the minutes slot -- if it's improper, # it's only by having been rounded up to the limit. redo Fix; # Start over. } # Otherwise there's not too many nonzero wheels, and there's no # improperly expressed wheels, so fall thru... } return @wheel; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub _render { # Make it into English my $direction = shift @_; my @wheel = map {; ( $_->[1] == 0) ? () # zero wheels : ($_->[1] == 1) ? "${$_}[1] ${$_}[0]" # singular : "${$_}[1] ${$_}[0]s" # plural } @_ ; return "just now" unless @wheel; # sanity $wheel[-1] .= $direction; return $wheel[0] if @wheel == 1; return "$wheel[0] and $wheel[1]" if @wheel == 2; $wheel[-1] = "and $wheel[-1]"; return join q{, }, @wheel; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1; __END__ so "1y 0d 1h 50m 50s", N=3, so you round at minutes to "1y 0d 1h 51m 0s", #That's okay, so fall thru. so "1y 1d 0h 59m 50s", N=3, so you round at minutes to "1y 1d 0h 60m 0s", but that's not improperly expressed, so you loop around and get "1y 1d 1h 0m 0s", which is short enough, and is properly expressed. =head1 NAME Time::Duration - rounded or exact English expression of durations =head1 SYNOPSIS Example use in a program that ends by noting its runtime: my $start_time = time(); use Time::Duration; # then things that take all that time, and then ends: print "Runtime ", duration(time() - $start_time), ".\n"; Example use in a program that reports age of a file: use Time::Duration; my $file = 'that_file'; my $age = $^T - (stat($file))[9]; # 9 = modtime print "$file was modified ", ago($age); =head1 DESCRIPTION This module provides functions for expressing durations in rounded or exact terms. In the first example in the Synopsis, using duration($interval_seconds): If the C is 3 seconds, this prints "Runtime: B<3 seconds>.". If it's 0 seconds, it's "Runtime: B<0 seconds>.". If it's 1 second, it's "Runtime: B<1 second>.". If it's 125 seconds, you get "Runtime: B<2 minutes and 5 seconds>.". If it's 3820 seconds (which is exactly 1h, 3m, 40s), you get it rounded to fit within two expressed units: "Runtime: B<1 hour and 4 minutes>.". Using duration_exact instead would return "Runtime: B<1 hour, 3 minutes, and 40 seconds>". In the second example in the Synopsis, using ago($interval_seconds): If the $age is 3 seconds, this prints "I was modified B<3 seconds ago>". If it's 0 seconds, it's "I was modified B", as a special case. If it's 1 second, it's "from B<1 second ago>". If it's 125 seconds, you get "I was modified B<2 minutes and 5 seconds ago>". If it's 3820 seconds (which is exactly 1h, 3m, 40s), you get it rounded to fit within two expressed units: "I was modified B<1 hour and 4 minutes ago>". Using ago_exact instead would return "I was modified B<1 hour, 3 minutes, and 40 seconds ago>". And if the file's modtime is, surprisingly, three seconds into the future, $age is -3, and you'll get the equally and appropriately surprising "I was modified B<3 seconds from now>." =head1 MILLISECOND MODE By default, this module assumes input is an integer representing number of seconds and only emits results based on the integer part of any floating-point values passed to it. However, if you set the variable C<$Time::Duration::MILLISECOND> to any true value, then the methods will interpret inputs as floating-point numbers and will emit results containing information about the number of milliseconds in the value. For example, C will return B<1 second and 21 milliseconds> in this mode. Millisecond mode is not enabled by default because this module sees heavy use and existing users of it may be relying on its implicit truncation of non-integer arguments. =head1 FUNCTIONS This module provides all the following functions, which are all exported by default when you call C. =over =item duration($seconds) =item duration($seconds, $precision) Returns English text expressing the approximate time duration of abs($seconds), with at most S> expressed units. (That is, duration($seconds) is the same as duration($seconds,2).) For example, duration(120) or duration(-120) is "2 minutes". And duration(0) is "0 seconds". The precision figure means that no more than that many units will be used in expressing the time duration. For example, 31,629,659 seconds is a duration of I 1 year, 1 day, 2 hours, and 59 seconds (assuming 1 year = exactly 365 days, as we do assume in this module). However, if you wanted an approximation of this to at most two expressed (i.e., nonzero) units, it would round it and truncate it to "1 year and 1 day". Max of 3 expressed units would get you "1 year, 1 day, and 2 hours". Max of 4 expressed units would get you "1 year, 1 day, 2 hours, and 59 seconds", which happens to be exactly true. Max of 5 (or more) expressed units would get you the same, since there are only four nonzero units possible in for that duration. =item duration_exact($seconds) Same as duration($seconds), except that the returned value is an exact (unrounded) expression of $seconds. For example, duration_exact(31629659) returns "1 year, 1 day, 2 hours, and 59 seconds later", which is I true. =item ago($seconds) =item ago($seconds, $precision) For a positive value of seconds, this prints the same as C>. For example, ago(120) is "2 minutes ago". For a negative value of seconds, this prints the same as C>. For example, ago(-120) is "2 minutes from now". As a special case, ago(0) returns "right now". =item ago_exact($seconds) Same as ago($seconds), except that the returned value is an exact (unrounded) expression of $seconds. =item from_now($seconds) =item from_now($seconds, $precision) =item from_now_exact($seconds) The same as ago(-$seconds), ago(-$seconds, $precision), ago_exact(-$seconds). For example, from_now(120) is "2 minutes from now". =item later($seconds) =item later($seconds, $precision) For a positive value of seconds, this prints the same as C>. For example, ago(120) is "2 minutes later". For a negative value of seconds, this prints the same as C>. For example, later(-120) is "2 minutes earlier". As a special case, later(0) returns "right then". =item later_exact($seconds) Same as later($seconds), except that the returned value is an exact (unrounded) expression of $seconds. =item earlier($seconds) =item earlier($seconds, $precision) =item earlier_exact($seconds) The same as later(-$seconds), later(-$seconds, $precision), later_exact(-$seconds). For example, earlier(120) is "2 minutes earlier". =item concise( I ... ) ) Concise takes the string output of one of the above functions and makes it more concise. For example, C<< ago(4567) >> returns "1 hour and 16 minutes ago", but C<< concise(ago(4567)) >> returns "1h16m ago". =back =head1 I18N/L10N NOTES Little of the internals of this module are English-specific. See source and/or contact me if you're interested in making a localized version for some other language than English. =head1 BACKSTORY I wrote the basic C function for use in Infobot (C), because I was tired of this sort of response from the Purl Infobot: me> Purl, seen Woozle? Woozle was last seen on #perl 20 days, 7 hours, 32 minutes and 40 seconds ago, saying: Wuzzle! I figured if it was 20 days ago, I don't care about the seconds. So once I had written C, I abstracted the code a bit and got all the other functions. =head1 CAVEAT This module calls a durational "year" an interval of exactly 365 days of exactly 24 hours each, with no provision for leap years or monkey business with 23/25 hour days (much less leap seconds!). But since the main work of this module is approximation, that shouldn't be a great problem for most purposes. =head1 SEE ALSO L, which is similarly named, but does something rather different. I (1987-1994), where the character Data would express time durations like "1 year, 20 days, 22 hours, 59 minutes, and 35 seconds" instead of rounding to "1 year and 21 days". This is because no-one ever told him to use Time::Duration. =head1 COPYRIGHT AND DISCLAIMER Copyright 2013, Sean M. Burke C; Avi Finkel, C, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Current maintainer Avi Finkel, C; Original author Sean M. Burke, C =cut