/usr/share/perl5/Test/MockTime/DateCalc.pm is in libtest-mocktime-datecalc-perl 5+ds-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 | # Copyright 2009, 2010 Kevin Ryde
# This file is part of Test-MockTime-DateCalc.
#
# Test-MockTime-DateCalc is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# Test-MockTime-DateCalc 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. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Test-MockTime-DateCalc. If not, see <http://www.gnu.org/licenses/>.
package Test::MockTime::DateCalc;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = 5;
BEGIN {
# Check that Date::Calc isn't already loaded.
#
# Week_of_Year() here is a representative func, present in Date::Calc 4.0
# and up, and not one that's mangled here (so as not to risk hitting that
# if something goes badly wrong). Maybe looking at %INC would be better.
#
if (Date::Calc->can('Week_of_Year')) {
die "Date::Calc already loaded, cannot fake after imports may have grabbed its functions";
}
}
# Date::Calc had a big rewrite in 4.0 of May 1998, no attempt to fake
# anything earlier than that
#
use Date::Calc 4.0;
package Date::Calc;
use strict;
use warnings;
no warnings 'redefine';
# Calc.xs in Date::Calc calls to the C time() func from its internal C
# function DateCalc_system_clock(), and also directly in its Gmtime(),
# Localtime(), Timezone() and Time_to_Date(). In each case that of course
# misses any fakery on the perl level time(). The replacements here go to
# perl time() for the current time, and stay with Date::Calc for conversions
# to d/m/y etc.
#
sub System_Clock {
my ($gmt) = @_;
return ($gmt ? Gmtime() : Localtime());
}
sub Today {
return (System_Clock(@_))[0,1,2];
}
sub Now {
return (System_Clock(@_))[3,4,5];
}
sub Today_and_Now {
return (System_Clock(@_))[0,1,2, 3,4,5];
}
sub This_Year {
return (System_Clock(@_))[0];
}
{
# anonymous sub to avoid adding anything to the Date::Calc namespace
my $default_to_time_func = sub {
my ($func, $time) = @_;
if (! defined $time) { $time = time(); }
return $func->($time);
};
{ my $orig;
BEGIN { $orig = \&Gmtime; }
sub Gmtime { return &$default_to_time_func ($orig, @_) }
}
{ my $orig;
BEGIN { $orig = \&Localtime; }
sub Localtime { return &$default_to_time_func ($orig, @_) }
}
{ my $orig;
BEGIN { $orig = \&Timezone; }
sub Timezone { return &$default_to_time_func ($orig, @_) }
}
{ my $orig;
BEGIN { $orig = \&Time_to_Date; }
sub Time_to_Date { return &$default_to_time_func ($orig, @_) }
}
}
1;
__END__
=for stopwords pre Ryde Test-MockTime-DateCalc pre-requisites
=head1 NAME
Test::MockTime::DateCalc -- fake time for Date::Calc functions
=head1 SYNOPSIS
use Test::MockTime;
use Test::MockTime::DateCalc; # before Date::Calc loads
# ...
use My::Module::Using::Date::Calc;
=head1 DESCRIPTION
C<Test::MockTime::DateCalc> arranges for the functions in C<Date::Calc> to
follow the Perl level C<time> function (see L<perlfunc>), and in particular
any fake date/time set there by C<Test::MockTime>. The following
C<Date::Calc> functions are changed
System_Clock
Today
Now
Today_and_Now
This_Year
Gmtime
Localtime
Timezone
Time_to_Date
C<Gmtime>, C<Localtime>, C<Timezone> and C<Time_to_Date> are made to default
to the Perl-level current C<time>. When called with an explicit time
argument they're unchanged.
=head2 Module Load Order
C<Test::MockTime> or similar fakery must be loaded first, before anything
with a C<time()> call, which includes C<Test::MockTime::DateCalc>. This is
the same as all C<CORE::GLOBAL> overrides, see L<CORE/OVERRIDING CORE
FUNCTIONS>.
C<Test::MockTime::DateCalc> must be loaded before C<Date::Calc>. If
C<Date::Calc> is already loaded then its functions might have been imported
into other modules and such imports are not affected by the redefinitions
made. For that reason C<Test::MockTime::DateCalc> demands it be the one to
load C<Date::Calc> for the first time. Usually this simply means having
C<Test::MockTime::DateCalc> at the start of a test script, before the things
you're going to test.
use strict;
use warnings;
use Test::MockTime ':all';
use Test::MockTime::DateCalc;
use My::Foo::Bar;
set_fixed_time('1981-01-01T00:00:00Z');
is (My::Foo::Bar::something(), 1981);
restore_time();
In a test script it's often good to have your own modules early to check
they correctly load their pre-requisites. You might want a separate test
script for that so you don't accidentally rely on
C<Test::MockTime::DateCalc> loading C<Date::Calc> for you.
=head2 Other Faking Modules
C<Test::MockTime::DateCalc> can be used with other modules which mangle the
Perl-level C<time> too. For example C<Time::Fake>,
use Time::Fake; # fakery first
use Test::MockTime::DateCalc;
Or C<Time::Mock>,
use Time::Mock; # fakery first
use Test::MockTime::DateCalc;
C<Time::Warp> (as of version 0.5) only exports a new C<time>, it's not a
core override and so can't be used with C<Test::MockTime::DateCalc>.
=head1 SEE ALSO
L<Date::Calc>, L<Test::MockTime>, L<Time::Fake>, L<Time::Mock>
L<faketime(1)>
=head1 HOME PAGE
http://user42.tuxfamily.org/test-mocktime-datecalc/index.html
=head1 COPYRIGHT
Copyright 2009, 2010 Kevin Ryde
Test-MockTime-DateCalc is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option) any
later version.
Test-MockTime-DateCalc 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. See the GNU General
Public License for more details.
You should have received a copy of the GNU General Public License along with
Test-MockTime-DateCalc. If not, see <http://www.gnu.org/licenses/>.
=cut
|