Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to mock Perl module Time::HiRes

There is a great Perl module Time::HiRes. I heavily use it in my library and want to write some tests. I have found 2 CPAN modules that mocks perl time() function, but both of them don't support Time::HiRes:

  • Time::Mock
  • Test::MockTime

How can I mock Time::HiRes sub gettimeofday()?

PS I want to fix tests for my module Time::ETA. Now I use ugly hack with sleep "mock", sometimes it works and sometimes it does not.

like image 596
bessarabov Avatar asked Oct 21 '22 04:10

bessarabov


1 Answers

You can write your own module with blackjack and hookers to mock gettimeofday. By some modifications of Test::MockTime i wrote:

#!/usr/bin/perl

package myMockTime;

use strict;
use warnings;
use Exporter qw( import );
use Time::HiRes ();
use Carp;

our @fixed = ();
our $accel = 1;
our $otime = Time::HiRes::gettimeofday;

our @EXPORT_OK = qw(
    set_fixed_time_of_day
    gettimeofday
    restore
    throttle
);

sub gettimeofday() {
    if ( @fixed ) {
        return wantarray ? @fixed : "$fixed[0].$fixed[1]";
    }
    else {
        return $otime + ( ( Time::HiRes::gettimeofday - $otime ) * $accel );
    }
}

sub set_fixed_time_of_day {
    my ( $time1, $time2 ) = @_;
    if ( ! defined $time1 || ! defined $time2 ) {
        croak('Incorrect usage');
    }
    @fixed = ( $time1, $time2 );
}

sub throttle {
    my $self = shift @_;
    return $accel unless @_;
    my $new = shift @_;
    $new or croak('Can not set throttle to zero');
    $accel = $new;
}

sub restore {
    @fixed = ();
}

1;

I think it has a lot of bugs and incomplete functionallity, work in this direction

like image 74
Suic Avatar answered Oct 27 '22 11:10

Suic