Merge branch 'unbundle_time_fake' into 'v2.0'
Unbundle Time::Fake See merge request lemonldap-ng/lemonldap-ng!125
This commit is contained in:
commit
97086f48cf
1
debian/control
vendored
1
debian/control
vendored
|
@ -43,6 +43,7 @@ Build-Depends-Indep: libapache-session-perl <!nocheck>,
|
||||||
libtest-mockobject-perl <!nocheck>,
|
libtest-mockobject-perl <!nocheck>,
|
||||||
libtest-pod-perl <!nocheck>,
|
libtest-pod-perl <!nocheck>,
|
||||||
libtext-unidecode-perl <!nocheck>,
|
libtext-unidecode-perl <!nocheck>,
|
||||||
|
libtime-fake-perl <!nocheck>,
|
||||||
libunicode-string-perl <!nocheck>,
|
libunicode-string-perl <!nocheck>,
|
||||||
liburi-perl <!nocheck>,
|
liburi-perl <!nocheck>,
|
||||||
libwww-perl <!nocheck>,
|
libwww-perl <!nocheck>,
|
||||||
|
|
|
@ -1,235 +0,0 @@
|
||||||
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.
|
|
|
@ -4,15 +4,12 @@ use strict;
|
||||||
use 5.10.0;
|
use 5.10.0;
|
||||||
use POSIX 'strftime';
|
use POSIX 'strftime';
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
|
use Time::Fake;
|
||||||
use_ok('Lemonldap::NG::Common::PSGI::Cli::Lib');
|
use_ok('Lemonldap::NG::Common::PSGI::Cli::Lib');
|
||||||
|
|
||||||
our $client;
|
our $client;
|
||||||
our $count = 1;
|
our $count = 1;
|
||||||
|
|
||||||
BEGIN {
|
|
||||||
require 't/Time-Fake.pm';
|
|
||||||
}
|
|
||||||
|
|
||||||
no warnings 'redefine';
|
no warnings 'redefine';
|
||||||
|
|
||||||
my $module;
|
my $module;
|
||||||
|
|
|
@ -1,235 +0,0 @@
|
||||||
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.
|
|
|
@ -57,6 +57,7 @@ use strict;
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use File::Find;
|
use File::Find;
|
||||||
use LWP::UserAgent;
|
use LWP::UserAgent;
|
||||||
|
use Time::Fake;
|
||||||
use URI::Escape;
|
use URI::Escape;
|
||||||
use Lemonldap::NG::Common::FormEncode;
|
use Lemonldap::NG::Common::FormEncode;
|
||||||
|
|
||||||
|
@ -65,7 +66,6 @@ use Lemonldap::NG::Common::FormEncode;
|
||||||
no warnings 'redefine';
|
no warnings 'redefine';
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
require 't/Time-Fake.pm';
|
|
||||||
use_ok('Lemonldap::NG::Portal::Main');
|
use_ok('Lemonldap::NG::Portal::Main');
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -155,6 +155,7 @@ BuildRequires: perl(Sys::Syslog)
|
||||||
BuildRequires: perl(Test::MockObject)
|
BuildRequires: perl(Test::MockObject)
|
||||||
BuildRequires: perl(Test::Pod) >= 1.00
|
BuildRequires: perl(Test::Pod) >= 1.00
|
||||||
BuildRequires: perl(Text::Unidecode)
|
BuildRequires: perl(Text::Unidecode)
|
||||||
|
BuildRequires: perl(Time::Fake)
|
||||||
BuildRequires: perl(Time::Local)
|
BuildRequires: perl(Time::Local)
|
||||||
BuildRequires: perl(Unicode::String)
|
BuildRequires: perl(Unicode::String)
|
||||||
BuildRequires: perl(URI)
|
BuildRequires: perl(URI)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user