File Coverage

blib/lib/Test/MockTime/DateCalc.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	3	4	75.0
condition			n/a
subroutine	18	18	100.0
pod			n/a
total	49	50	98.0

# Copyright 2009, 2010, 2011, 2019 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 .


package Test::MockTime::DateCalc;
use strict;

use vars '$VERSION';
$VERSION = 7;

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;

# 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.
#

{
  local $^W = 0; # no warnings
  eval <<'HERE' or die;
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];
}
1
HERE
}

{
    local $^W = 0; # no warnings
    eval <<'HERE' or die;

# 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
HERE
}

1;
__END__