pax_global_header00006660000000000000000000000064125435376750014533gustar00rootroot0000000000000052 comment=7f68d0a27e88e24cb2fb5161e297ba9fa859c8b4 libtime-mock-perl-0.0.2/000077500000000000000000000000001254353767500150465ustar00rootroot00000000000000libtime-mock-perl-0.0.2/Build.PL000066400000000000000000000015271254353767500163470ustar00rootroot00000000000000 use strict; use warnings; use Module::Build; my $build_class = 'Module::Build'; my $builder = $build_class->new( module_name => 'Time::Mock', license => 'perl', dist_version_from => 'lib/Time/Mock.pm', requires => { }, build_requires => { 'Module::Build' => 0.26, 'Test::More' => 0, }, recommends => { 'Date::Parse' => 2.27, }, add_to_cleanup => [ qw(Time-Mock-* META.yml)], # create_makefile_pl => 'passthrough', meta_merge => { resources => { homepage => 'http://scratchcomputing.com/', bugtracker => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Mock', #MailingList => 'mailto:...', repository => 'http://svn.scratchcomputing.com/Time-Mock/trunk', } }, ); $builder->create_build_script(); # vi:syntax=perl:ts=2:sw=2:et:sta libtime-mock-perl-0.0.2/Changes000066400000000000000000000004501254353767500163400ustar00rootroot00000000000000Revision history for Time-Mock v0.0.2 2009-07-14 * added set() and `set => $timestring` option for import() v0.0.1 2008-05-09 * first public release - alpha interface See the source code repository for more detail. http://svn.scratchcomputing.com/Time-Mock/trunk vim:ts=2:sw=2:et:sta libtime-mock-perl-0.0.2/MANIFEST000066400000000000000000000001761254353767500162030ustar00rootroot00000000000000Build.PL Changes lib/Time/Mock.pm MANIFEST This list of files MANIFEST.SKIP META.yml README t/00-load.t t/import.t t/time.t libtime-mock-perl-0.0.2/MANIFEST.SKIP000066400000000000000000000010071254353767500167420ustar00rootroot00000000000000# Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \b_darcs\b \b.cvsignore\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.swp$ # Avoid archives of this distribution \b-v?[\d\.\_]+ # Avoid Devel::Cover files. \bcover_db\b libtime-mock-perl-0.0.2/META.yml000066400000000000000000000013451254353767500163220ustar00rootroot00000000000000--- name: Time-Mock version: v0.0.2 author: - 'Eric Wilhelm @ ' abstract: shift and scale time license: perl resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Mock homepage: http://scratchcomputing.com/ license: http://dev.perl.org/licenses/ repository: http://svn.scratchcomputing.com/Time-Mock/trunk build_requires: Module::Build: 0.26 Test::More: 0 recommends: Date::Parse: 2.27 configure_requires: Module::Build: 0.3401 provides: Time::Mock: file: lib/Time/Mock.pm version: v0.0.2 Time::Mock::Original: file: lib/Time/Mock.pm generated_by: Module::Build version 0.3401 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 libtime-mock-perl-0.0.2/README000066400000000000000000000004231254353767500157250ustar00rootroot00000000000000Time-Mock INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Time::Mock libtime-mock-perl-0.0.2/lib/000077500000000000000000000000001254353767500156145ustar00rootroot00000000000000libtime-mock-perl-0.0.2/lib/Time/000077500000000000000000000000001254353767500165125ustar00rootroot00000000000000libtime-mock-perl-0.0.2/lib/Time/Mock.pm000066400000000000000000000133151254353767500177440ustar00rootroot00000000000000package Time::Mock; $VERSION = v0.0.2; use warnings; use strict; use Carp; =head1 NAME Time::Mock - shift and scale time =head1 SYNOPSIS Speed up your sleep(), alarm(), and time() calls. use Time::Mock throttle => 100; use Your::Code; =head1 ABOUT Test::MockTime is nice, but doesn't allow you to accelerate the timestep and doesn't deal with Time::HiRes or give you any way to change the time across forks. TODO: replace Time::HiRes functions with wrappers TODO: finish the interfaces to real time/sleep/alarm =head1 Replaces These core functions are replaced. Eventually, much of the same bits from Time::HiRes will be correspondingly overwritten. =over =item time =item localtime =item gmtime =item sleep Sleeps for 1/$throttle. =item alarm Alarm happens in 1/$throttle. =back =cut # TODO issue: anybody that said 'use Time::HiRes' before we arrived got # imports of the original versions. Complain very loudly? use Time::HiRes (); BEGIN { package Time::Mock::Original; *time = \&Time::HiRes::time; *sleep = \&Time::HiRes::sleep; *alarm = \&Time::HiRes::alarm; } sub time (); sub localtime (;$); sub gmtime (;$); sub sleep (;$); sub alarm (;$); BEGIN { *CORE::GLOBAL::time = \&time; *CORE::GLOBAL::localtime = \&localtime; *CORE::GLOBAL::gmtime = \&gmtime; *CORE::GLOBAL::sleep = \&sleep; *CORE::GLOBAL::alarm = \&alarm; no warnings 'redefine'; *Time::HiRes::time = sub () {goto &_hitime}; *Time::HiRes::sleep = sub (;@) {goto &sleep}; *Time::HiRes::alarm = sub ($;$) {goto &alarm}; } sub import { my $class = shift; (@_ % 2) and croak("odd number of elements in argument list"); my (%args) = @_; foreach my $k (keys(%args)) { $class->can($k) or croak("unknown method '$k'"); $class->$k($args{$k}); } } =head1 Class Methods These are the knobs on your time machine, but note that it is probably best to adjust them only once: see L. For convenience, import() takes will call these methods with each key in its argument list. perl -MTime::Mock=throttle,600,set,"2009-11-01 00:59" dst_bug.pl =head2 throttle Get or set the throttle. Time::Mock->throttle(10_000); =head2 offset Get or set the offset. Time::Mock->offset(120); =head2 set Set the time to a given value. This may be a numeric time or anything parseable by Date::Parse::str2time() (you need to install Date::Parse to enable this.) Time::Mock->set("2009-11-01 00:59"); =head1 Caveats This package remembers the actual system time when it was loaded and makes adjustments from there. Future versions might change this behavior if I can think of a good reason and scheme for that. =head2 forks and threads The throttle value will hold across forks, but there is no support for propagating changes to child processes. So, set the knobs only before you fork! Don't ask about threads unless you're asking about me applying your patch thanks. =head2 Networking and System stuff We're only lying about the clock inside of Perl, not magically messing with the universe. =head2 Time Travel is Dangerous I suggest that you set the knobs at import() and don't mess with them after that unless you're well aware of how your code is using time. Messing with the throttle during runtime could also give your code the illusion of time going backwards. If your code tries to do math with the return values of time() before and after a slow-down, there could be trouble. Changing the throttle while an alarm() is set won't change the original alarm time. There would be a similar caveat about sleep() if I hadn't already mentioned forks ;-) Finally, don't ever let your past self see your future self. =cut our $accel = 1; sub throttle { my $class = shift; return $accel unless(@_); my $v = shift(@_); $v or croak("cannot set throttle to zero"); $accel = $v; } our $offset = 0; sub offset { my $class = shift; return $offset unless(@_); $offset = shift(@_); } BEGIN { *_realtime = \&Time::Mock::Original::time}; our $otime = _realtime; sub set { my $class = shift; my $set = shift(@_) or croak("must have time to set"); unless($set =~ m/^\d+$/) { require Date::Parse; $set = Date::Parse::str2time($set); } $offset = $set - $otime; } sub _hitime () { return(($otime + $offset) + (_realtime - $otime) * $accel); } sub time () { return sprintf("%0.0f", _hitime); } sub localtime (;$) { my ($time) = @_; $time = time unless(defined $time); return CORE::localtime($time); } sub gmtime (;$) { my ($time) = @_; $time = time unless(defined $time); return CORE::gmtime($time);; } sub sleep (;$) { my ($length) = @_; return CORE::sleep unless($length); return Time::Mock::Original::sleep($length / $accel); } sub alarm (;$) { my ($length) = @_; $length = $_ unless(defined($length)); return CORE::alarm(0) unless($length); return Time::Mock::Original::alarm($length / $accel); } =head1 AUTHOR Eric Wilhelm @ http://scratchcomputing.com/ =head1 BUGS If you found this module on CPAN, please report any bugs or feature requests through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. If you pulled this development version from my /svn/, please contact me directly. =head1 COPYRIGHT Copyright (C) 2008 Eric L. Wilhelm, All Rights Reserved. =head1 NO WARRANTY Absolutely, positively NO WARRANTY, neither express or implied, is offered with this software. You use this software at your own risk. In case of loss, no person or entity owes you anything whatsoever. You have been warned. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # vi:ts=2:sw=2:et:sta 1; libtime-mock-perl-0.0.2/t/000077500000000000000000000000001254353767500153115ustar00rootroot00000000000000libtime-mock-perl-0.0.2/t/00-load.t000066400000000000000000000003741254353767500166360ustar00rootroot00000000000000 use warnings; use strict; use Test::More tests => 1; my $package = 'Time::Mock'; use_ok('Time::Mock') or BAIL_OUT('cannot load Time::Mock'); eval {require version}; diag("Testing $package ", $package->VERSION ); # vim:syntax=perl:ts=2:sw=2:et:sta libtime-mock-perl-0.0.2/t/import.t000077500000000000000000000010141254353767500170070ustar00rootroot00000000000000#!/usr/bin/perl use warnings; use strict; use Test::More qw(no_plan); my $otime = time; use Time::Mock throttle => 100, offset => 10_000; is(Time::Mock->throttle, 100); is(Time::Mock->offset, 10_000); my $start = time; cmp_ok($start, '>=', $otime + 10_000); sleep(1); my $end = time; cmp_ok($end, '>=', $start + 1); cmp_ok($end, '<=', $start + 2); eval {Time::Mock->import(foo => 1)}; like($@, qr/^unknown method 'foo'/); eval {Time::Mock->import('blah')}; like($@, qr/^odd number of elements/); # vim:ts=2:sw=2:et:sta libtime-mock-perl-0.0.2/t/time.t000077500000000000000000000012411254353767500164350ustar00rootroot00000000000000#!/usr/bin/perl use warnings; use strict; use Test::More qw(no_plan); my $otime; BEGIN {$otime = time;} use Time::Mock; my $time = time; ok($time < $otime + 5); Time::Mock->throttle(10); alarm(5); sleep(4); alarm(0); #warn scalar localtime; ok(Time::Mock::Original::time < $otime + 2); Time::Mock->throttle(10_000); is(Time::Mock->throttle, 10_000) or die; is(Time::Mock->throttle, 10_000); Time::Mock::Original::sleep(1); my $later = time; ok($later > $otime + 10_000); Time::Mock->throttle(1); $otime = time; ok($otime < $later); { Time::Mock->throttle(1/10_000); my $slow = time; is(scalar(localtime), scalar(localtime($slow))); } # vim:ts=2:sw=2:et:sta