The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package # no_index
  ControlTime;

our ($time, $frac);

BEGIN {
  # override it now, decide at each call what to return
  *CORE::GLOBAL::time = \&fake_or_real_time;
}

# serve fake time if set, otherwise real time
sub fake_or_real_time {
  $time || CORE::time();
}

# OO mostly for the sake of simple, intuitive scoping
sub new {
  my $class = shift;
  my $self = bless [@_], $class;
  $self->set( @$self ) if @$self;
  $self;
}

sub set {
  my $self = shift;
  $time = shift;
  $self->fraction(shift) if @_;
}

sub fraction {
  my ($self, $f) = @_;
  $self->mock_time_hires;
  $frac = $f;
}

my $mocked_hires;
sub mock_time_hires {
  return if $mocked_hires++;

  $INC{"Time/HiRes.pm"} = 1;

  *Time::HiRes::gettimeofday = sub {
    my @t = (fake_or_real_time(), $frac);
    return wantarray ? @t : sprintf("%d.%06d", @t);
  };

  {
    no warnings 'once';
    *Time::HiRes::time = sub {
      scalar Time::HiRes::gettimeofday();
    };
  }
}

sub fake_have_hires {
  my ($self, $bool) = @_;
  $self->mock_time_hires;

  require Time::Stamp;
  no warnings 'redefine';
  *Time::Stamp::_have_hires = sub { $bool };
}

sub reset {
  $time = $frac = undef;
}

sub DESTROY { shift->reset }

1;