236 lines
5.6 KiB
Perl
236 lines
5.6 KiB
Perl
![]() |
package Time::Fake;
|
||
|
use Carp;
|
||
|
use strict;
|
||
|
use vars '$VERSION';
|
||
|
$VERSION = "0.11";
|
||
|
|
||
|
#####################
|
||
|
|
||
|
my $OFFSET = 0;
|
||
|
|
||
|
*CORE::GLOBAL::time = sub() { CORE::time() + $OFFSET };
|
||
|
|
||
|
*CORE::GLOBAL::localtime = sub(;$) {
|
||
|
@_ ? CORE::localtime($_[0])
|
||
|
: CORE::localtime(CORE::time() + $OFFSET);
|
||
|
};
|
||
|
|
||
|
*CORE::GLOBAL::gmtime = sub(;$) {
|
||
|
@_ ? CORE::gmtime($_[0])
|
||
|
: CORE::gmtime(CORE::time() + $OFFSET);
|
||
|
};
|
||
|
|
||
|
sub import {
|
||
|
my $pkg = shift;
|
||
|
$pkg->offset(shift);
|
||
|
}
|
||
|
|
||
|
sub offset {
|
||
|
my $pkg = shift;
|
||
|
return $OFFSET if !@_;
|
||
|
|
||
|
my $old_offset = $OFFSET;
|
||
|
$OFFSET = _to_offset(shift);
|
||
|
return $old_offset;
|
||
|
}
|
||
|
|
||
|
sub reset {
|
||
|
shift->offset(0);
|
||
|
}
|
||
|
|
||
|
my %mult = (
|
||
|
s => 1,
|
||
|
m => 60,
|
||
|
h => 60*60,
|
||
|
d => 60*60*24,
|
||
|
M => 60*60*24*30,
|
||
|
y => 60*60*24*365,
|
||
|
);
|
||
|
|
||
|
sub _to_offset {
|
||
|
my $t = shift || return 0;
|
||
|
|
||
|
if ($t =~ m/^([+-]\d+)([smhdMy]?)$/) {
|
||
|
$t = $1 * $mult{ $2 || "s" };
|
||
|
|
||
|
} elsif ($t !~ m/\D/) {
|
||
|
$t = $t - CORE::time;
|
||
|
|
||
|
} else {
|
||
|
croak "Invalid time offset: `$t'";
|
||
|
}
|
||
|
|
||
|
return $t;
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
|
__END__
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
Time::Fake - Simulate different times without changing your system clock
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
|
Pretend we are running 1 day in the future:
|
||
|
|
||
|
use Time::Fake '+1d';
|
||
|
|
||
|
Pretend we are running 1 year in the past:
|
||
|
|
||
|
use Time::Fake '-1y';
|
||
|
|
||
|
Pretend the script started at epoch time 1234567:
|
||
|
|
||
|
use Time::Fake 1234567;
|
||
|
|
||
|
See what an existing script would do if run 20 years in the future:
|
||
|
|
||
|
% perl -MTime::Fake="+20y" test.pl
|
||
|
|
||
|
Run a section of code in a time warp:
|
||
|
|
||
|
use Time::Fake;
|
||
|
|
||
|
# do some setup
|
||
|
|
||
|
Time::Fake->offset("+1y");
|
||
|
run_tests(); # thinks it's a year ahead
|
||
|
|
||
|
Time::Fake->reset; # back to the present
|
||
|
|
||
|
=head1 DESCRIPTION
|
||
|
|
||
|
Use this module to achieve the effect of changing your system clock, but
|
||
|
without actually changing your system clock. It overrides the Perl builtin
|
||
|
subs C<time>, C<localtime>, and C<gmtime>, causing them to return a
|
||
|
"faked" time of your choice. From the script's point of view, time still
|
||
|
flows at the normal rate, but it is just offset as if it were executing
|
||
|
in the past or present.
|
||
|
|
||
|
You may find this module useful in writing test scripts for code that has
|
||
|
time-sensitive logic.
|
||
|
|
||
|
=head1 USAGE
|
||
|
|
||
|
=head2 Using and importing:
|
||
|
|
||
|
use Time::Fake $t;
|
||
|
|
||
|
Is equivalent to:
|
||
|
|
||
|
use Time::Fake;
|
||
|
Time::Fake->offset($t);
|
||
|
|
||
|
See below for arguments to C<offset>. This usage makes it easy to
|
||
|
fake the time for existing scripts, as in:
|
||
|
|
||
|
% perl -MTime::Fake=+1y script.pl
|
||
|
|
||
|
=head2 offset
|
||
|
|
||
|
Time::Fake->offset( [$t] );
|
||
|
|
||
|
C<$t> is either an epoch time, or a relative offset of the following
|
||
|
form:
|
||
|
|
||
|
+3 # 3 seconds in the future
|
||
|
-3s # 3 seconds in the past
|
||
|
+1h # 1 hour in the future
|
||
|
etc..
|
||
|
|
||
|
Relative offsets must begin with a plus or minus symbol. The supported
|
||
|
units are:
|
||
|
|
||
|
s second
|
||
|
m minute
|
||
|
h hour
|
||
|
d day (24 hours)
|
||
|
M month (30 days)
|
||
|
y year (365 days)
|
||
|
|
||
|
If C<$t> is an epoch time, then C<time>, C<localtime>, and C<gmtime>
|
||
|
will act as though the the current time (when C<offset> was called) was
|
||
|
actually at C<$t> epoch seconds.
|
||
|
Otherwise, the offset C<$t> will be added to the times returned by these
|
||
|
builtin subs.
|
||
|
|
||
|
When C<$t> is false, C<time>, C<localtime>, C<gmtime>
|
||
|
remain overridden, but their behavior resets to reflect the actual
|
||
|
system time.
|
||
|
|
||
|
When C<$t> is omitted, nothing is changed, but C<offset> returns the
|
||
|
current additive offset (in seconds). Otherwise, its return value is
|
||
|
the I<previous> offset.
|
||
|
|
||
|
C<offset> may be called several times. However, I<The effect of multiple
|
||
|
calls is NOT CUMULATIVE.> That is:
|
||
|
|
||
|
Time::Fake->offset("+1h");
|
||
|
Time::Fake->offset("+1h");
|
||
|
|
||
|
## same as
|
||
|
# Time::Fake->offset("+1h");
|
||
|
|
||
|
## NOT the same as
|
||
|
# Time::Fake->offset("+2h");
|
||
|
|
||
|
Each call to C<offset> completely cancels out the effect of any
|
||
|
previous calls. To make the effect cumulative, use the return value
|
||
|
of calling C<offset> with no arguments:
|
||
|
|
||
|
Time::Fake->offset("+1h");
|
||
|
...
|
||
|
Time::Fake->offset( Time::Fake->offset + 3600 ); # add another hour
|
||
|
|
||
|
=head2 reset
|
||
|
|
||
|
Time::Fake->reset;
|
||
|
|
||
|
Is the same as:
|
||
|
|
||
|
Time::Fake->offset(0);
|
||
|
|
||
|
That is, it returns all the affected builtin subs to their
|
||
|
default behavior -- reporing the actual system time.
|
||
|
|
||
|
=head1 KNOWN CAVEATS
|
||
|
|
||
|
Time::Fake must be loaded at C<BEGIN>-time (e.g., with a standard
|
||
|
C<use> statement). It must be loaded before perl I<compiles> any code
|
||
|
that uses C<time>, C<localtime>, or C<gmtime>. Due to inherent
|
||
|
limitations in overriding builtin subs, any code that was compiled
|
||
|
before loading Time::Fake will not be affected.
|
||
|
|
||
|
Because the system clock is not being changed, only Perl code that
|
||
|
uses C<time>, C<localtime>, or C<gmtime> will be fooled about the date.
|
||
|
In particular, the operating system is not fooled,
|
||
|
nor are other programs. If your Perl code modifies a file for example,
|
||
|
the file's modification time will reflect the B<actual> (not faked) time.
|
||
|
Along the same lines, if your Perl script obtains the time from somewhere
|
||
|
other than the affected builtins subs (e.g., C<qx/date/>), the actual
|
||
|
(not faked) time will be reflected.
|
||
|
|
||
|
Time::Fake doesn't affect -M, -A, -C filetest operators in the way you'd
|
||
|
probably want. These still report the B<actual> (not faked) script start
|
||
|
time minus file access time.
|
||
|
|
||
|
Time::Fake has not been tested with other modules that override the time
|
||
|
builtins, e.g., Time::HiRes.
|
||
|
|
||
|
=head1 SEE ALSO
|
||
|
|
||
|
Time::Warp, which uses XS to fool more of Perl.
|
||
|
|
||
|
=head1 AUTHOR
|
||
|
|
||
|
Time::Fake is written by Mike Rosulek E<lt>mike@mikero.comE<gt>. Feel
|
||
|
free to contact me with comments, questions, patches, or whatever.
|
||
|
|
||
|
=head1 COPYRIGHT
|
||
|
|
||
|
Copyright (c) 2008 Mike Rosulek. All rights reserved. This module is free
|
||
|
software; you can redistribute it and/or modify it under the same terms as Perl
|
||
|
itself.
|