267 lines
6.5 KiB
Perl
267 lines
6.5 KiB
Perl
package Test::MockTime;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp();
|
|
use Exporter();
|
|
*import = \&Exporter::import;
|
|
our @EXPORT_OK = qw(
|
|
set_relative_time
|
|
set_absolute_time
|
|
set_fixed_time
|
|
restore_time
|
|
);
|
|
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK, );
|
|
our $VERSION = '0.17';
|
|
our $offset = 0;
|
|
our $fixed = undef;
|
|
|
|
BEGIN {
|
|
*CORE::GLOBAL::time = \&Test::MockTime::time;
|
|
*CORE::GLOBAL::localtime = \&Test::MockTime::localtime;
|
|
*CORE::GLOBAL::gmtime = \&Test::MockTime::gmtime;
|
|
}
|
|
|
|
sub set_relative_time {
|
|
my ($relative) = @_;
|
|
if ( ( $relative eq __PACKAGE__ )
|
|
|| ( UNIVERSAL::isa( $relative, __PACKAGE__ ) ) )
|
|
{
|
|
Carp::carp("Test::MockTime::set_relative_time called incorrectly\n");
|
|
}
|
|
$offset = $_[-1]; # last argument. might have been called in a OO syntax?
|
|
return $offset;
|
|
}
|
|
|
|
sub _time {
|
|
my ( $time, $spec ) = @_;
|
|
if ( $time !~ /\A -? \d+ \z/xms ) {
|
|
$spec ||= '%Y-%m-%dT%H:%M:%SZ';
|
|
}
|
|
if ($spec) {
|
|
require Time::Piece;
|
|
$time = Time::Piece->strptime( $time, $spec )->epoch();
|
|
}
|
|
return $time;
|
|
}
|
|
|
|
sub set_absolute_time {
|
|
my ( $time, $spec ) = @_;
|
|
if ( ( $time eq __PACKAGE__ ) || ( UNIVERSAL::isa( $time, __PACKAGE__ ) ) )
|
|
{
|
|
Carp::carp("Test::MockTime::set_absolute_time called incorrectly\n");
|
|
}
|
|
$time = _time( $time, $spec );
|
|
$offset = $time - CORE::time;
|
|
return $offset;
|
|
}
|
|
|
|
sub set_fixed_time {
|
|
my ( $time, $spec ) = @_;
|
|
if ( ( $time eq __PACKAGE__ ) || ( UNIVERSAL::isa( $time, __PACKAGE__ ) ) )
|
|
{
|
|
Carp::carp("Test::MockTime::set_fixed_time called incorrectly\n");
|
|
}
|
|
$time = _time( $time, $spec );
|
|
$fixed = $time;
|
|
return $fixed;
|
|
}
|
|
|
|
sub time() {
|
|
if ( defined $fixed ) {
|
|
return $fixed;
|
|
}
|
|
else {
|
|
return ( CORE::time + $offset );
|
|
}
|
|
}
|
|
|
|
sub localtime (;$) {
|
|
my ($time) = @_;
|
|
if ( !defined $time ) {
|
|
$time = Test::MockTime::time();
|
|
}
|
|
return CORE::localtime($time);
|
|
}
|
|
|
|
sub gmtime (;$) {
|
|
my ($time) = @_;
|
|
if ( !defined $time ) {
|
|
$time = Test::MockTime::time();
|
|
}
|
|
return CORE::gmtime($time);
|
|
}
|
|
|
|
sub restore {
|
|
$offset = 0;
|
|
$fixed = undef;
|
|
return;
|
|
}
|
|
*restore_time = \&restore;
|
|
|
|
1;
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Test::MockTime - Replaces actual time with simulated time
|
|
|
|
=head1 VERSION
|
|
|
|
Version 0.17
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Test::MockTime qw( :all );
|
|
set_relative_time(-600);
|
|
|
|
# do some tests depending on time increasing from 600 seconds ago
|
|
|
|
set_absolute_time(0);
|
|
|
|
# do some more tests depending on time starting from the epoch
|
|
# epoch may vary according to platform. see perlport.
|
|
|
|
set_fixed_time(CORE::time());
|
|
|
|
# do some more tests depending on time staying at the current actual time
|
|
|
|
set_absolute_time('1970-01-01T00:00:00Z');
|
|
|
|
# do some tests depending on time starting at Unix epoch time
|
|
|
|
set_fixed_time('01/01/1970 00:00:00', '%m/%d/%Y %H:%M:%S');
|
|
|
|
# do some tests depending on time staying at the Unix epoch time
|
|
|
|
restore_time();
|
|
|
|
# resume normal service
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module was created to enable test suites to test code at specific
|
|
points in time. Specifically it overrides localtime, gmtime and time at
|
|
compile time and then relies on the user supplying a mock time via
|
|
set_relative_time, set_absolute_time or set_fixed_time to alter future
|
|
calls to gmtime,time or localtime.
|
|
|
|
=head1 SUBROUTINES/METHODS
|
|
|
|
=over
|
|
|
|
=item set_absolute_time
|
|
|
|
If given a single, numeric argument, the argument is an absolute time (for
|
|
example, if 0 is supplied, the absolute time will be the epoch), and
|
|
calculates the offset to allow subsequent calls to time, gmtime and localtime
|
|
to reflect this.
|
|
|
|
for example, in the following code
|
|
|
|
Test::MockTime::set_absolute_time(0);
|
|
my ($start) = time;
|
|
sleep 2;
|
|
my ($end) = time;
|
|
|
|
The $end variable should contain 2 seconds past the epoch;
|
|
|
|
If given two arguments, the first argument is taken to be an absolute time in
|
|
some string format (for example, "01/01/1970 00:00:00"). The second argument
|
|
is taken to be a C<strptime> format string (for example, "%m/%d/%Y %H:%M:%S").
|
|
If a single argument is given, but that argument is not numeric, a
|
|
C<strptime> format string of "%Y-%m-%dT%H:%M:%SZ" is assumed.
|
|
|
|
for example, in the following code
|
|
|
|
Test::MockTime::set_absolute_time('1970-01-01T00:00:00Z');
|
|
my ($start) = time;
|
|
sleep 2;
|
|
my ($end) = time;
|
|
|
|
The $end variable should contain 2 seconds past the Unix epoch;
|
|
|
|
=item set_relative_time($relative)
|
|
|
|
takes as an argument an relative value from current time (for example, if -10
|
|
is supplied, current time be converted to actual machine time - 10 seconds)
|
|
and calculates the offset to allow subsequent calls to time,gmtime and localtime
|
|
to reflect this.
|
|
|
|
for example, in the following code
|
|
|
|
my ($start) = time;
|
|
Test::MockTime::set_relative_time(-600);
|
|
sleep 600;
|
|
my ($end) = time;
|
|
|
|
The $end variable should contain either the same or very similar values to the
|
|
$start variable.
|
|
|
|
=item set_fixed_time
|
|
|
|
If given a single, numeric argument, the argument is an absolute time (for
|
|
example, if 0 is supplied, the absolute time will be the epoch). All
|
|
subsequent calls to gmtime, localtime and time will return this value.
|
|
|
|
for example, in the following code
|
|
|
|
Test::MockTime::set_fixed_time(time)
|
|
my ($start) = time;
|
|
sleep 3;
|
|
my ($end) = time;
|
|
|
|
the $end variable and the $start variable will contain the same results
|
|
|
|
If given two arguments, the first argument is taken to be an absolute time in
|
|
some string format (for example, "01/01/1970 00:00:00"). The second argument
|
|
is taken to be a C<strptime> format string (for example, "%m/%d/%Y %H:%M:%S").
|
|
If a single argument is given, but that argument is not numeric, a
|
|
C<strptime> format string of "%Y-%m-%dT%H:%M:%SZ" is assumed.
|
|
|
|
=item restore()
|
|
|
|
restore the default time handling values. C<restore_time> is an alias. When
|
|
exported with the 'all' tag, this subroutine is exported as C<restore_time>.
|
|
|
|
=back
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT
|
|
|
|
Test::MockTime requires no configuration files or environment variables.
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
Test::MockTime depends on the following non-core Perl modules.
|
|
|
|
=over
|
|
|
|
=item *
|
|
L<Time::Piece 1.08 or greater|Time::Piece>
|
|
|
|
=back
|
|
|
|
=head1 INCOMPATIBILITIES
|
|
|
|
None reported
|
|
|
|
=head1 BUGS AND LIMITATIONS
|
|
|
|
Probably.
|
|
|
|
=head1 AUTHOR
|
|
|
|
David Dick <ddick@cpan.org>
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the same terms as Perl itself.
|
|
|
|
=cut
|
|
|
|
=head1 ACKNOWLEDGEMENTS
|
|
|
|
Thanks to a use.perl.org journal entry <http://use.perl.org/~geoff/journal/20660> by
|
|
Geoffrey Young.
|