view release on metacpan or  search on metacpan

lib/Bench.pm  view on Meta::CPAN

package Bench;

our $VERSION = '0.10'; # VERSION

use 5.010001;
use strict;
use warnings;

use Time::HiRes qw/gettimeofday tv_interval/;

my $bench_called;
my ($t0, $ti);

sub _set_start_time {
    $t0 = [gettimeofday];
}

sub _set_interval {
    $ti = tv_interval($t0, [gettimeofday]);
}

sub import {
    _set_start_time;
    no strict 'refs';
    my $caller = caller();
    *{"$caller\::bench"} = \&bench;
}

sub _fmt_num {
    my ($num, $unit, $nsig) = @_;
    $nsig //= 4;
    my $fmt;

    my $l = $num ? int(log(abs($num))/log(10)) : 0;
    if ($l >= $nsig) {
        $fmt = "%.0f";
    } elsif ($l < 0) {
        $fmt = "%.${nsig}f";
    } else {
        $fmt = "%.".($nsig-$l-1)."f";
    }
    #say "D:fmt=$fmt";
    sprintf($fmt, $num) . ($unit // "");
}

sub bench($;$) {
    my ($subs0, $opts) = @_;
    $opts //= {};
    $opts   = {n=>$opts} if ref($opts) ne 'HASH';
    $opts->{t} //= 1;
    $opts->{n} //= 100;
    my %subs;
    if (ref($subs0) eq 'CODE') {
        %subs = (a=>$subs0);
    } elsif (ref($subs0) eq 'HASH') {
        %subs = %$subs0;
    } elsif (ref($subs0) eq 'ARRAY') {
        my $name = "a";
        for (@$subs0) { $subs{$name++} = $_ }
    } else {
        die "Usage: bench(CODE|{a=>CODE,b=>CODE, ...}|[CODE, CODE, ...], ".
            "{opt=>val, ...})";
    }
    die "Please specify one or more subs"
        unless keys %subs;

    my $use_dumbbench;
    if ($opts->{dumbbench}) {
        $use_dumbbench++;
        require Dumbbench;
    } elsif (!defined $opts->{dumbbench}) {
        $use_dumbbench++ if $INC{"Dumbbench.pm"};
    }

    my $void = !defined(wantarray);
    if ($use_dumbbench) {

        $opts->{dumbbench_options} //= {};
        my $bench = Dumbbench->new(%{ $opts->{dumbbench_options} });
        $bench->add_instances(
            map { Dumbbench::Instance::PerlSub->new(code => $subs{$_}) }
                keys %subs
        );
        $bench->run;
        $bench->report;