view release on metacpan or  search on metacpan

lib/Chj/time_this.pm  view on Meta::CPAN

#
# Copyright (c) 2013-2022 Christian Jaeger, copying@christianjaeger.ch
#
# This is free software, offered under either the same terms as perl 5
# or the terms of the Artistic License version 2 or the terms of the
# MIT License (Expat version). See the file COPYING.md that came
# bundled with this file.
#

# Depends: ()

=head1 NAME

Chj::time_this - benchmarking function that also returns the result(s)

=head1 SYNOPSIS

    use Chj::tim;
    my $res = time_this { somefunc(66) }; # prints timing to stderr
    # or
    my $res = time_this { somefunc(66) } "somefunc"; # included in message
    # or
    my $res = time_this { somefunc(66) }
                 msg => "somefunc", n => 10; # run thunk 10 times
    # or
    my $res = time_this { somefunc(66) } out => \@t; # push to @t instead of stderr

=head1 DESCRIPTION


Currently does not divide the timings by the number of iterations.

Currently does not subtract the overhead of calling the thunk (as
Benchmark.pm does, but can't use it since it doesn't return values;
should we wrap and use assignment instead? But then timings are off
again.)

Also should probably follow the output format of Benchmark.pm

=head1 SEE ALSO

 L<Benchmark>

=head1 NOTE

This is alpha software! Read the status section in the package README
or on the L<website|http://functional-perl.org/>.

=cut

package Chj::time_this;
use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use Exporter "import";

our @EXPORT      = qw(time_this);
our @EXPORT_OK   = qw();
our %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);

my $fields = [qw(user system cuser csystem)];

sub time_this (&;@) {
    my ($thunk, @args) = @_;
    my $wantarray = wantarray;    ## no critic
    my $args      = {};
    my $maybe_msg
        = @args == 1 ? $args[0] : do { $args = +{@args}; $$args{msg} };
    my $n = $$args{n} // 1;

    my $a = [times];
    my @res;
    for (1 .. $n) {
        @res = $wantarray ? &$thunk() : scalar &$thunk();
    }
    my $b = [times];

    my $d      = [map { $$fields[$_] . " = " . ($$b[$_] - $$a[$_]) } 0 .. $#$a];
    my $forstr = defined($maybe_msg) ? " for $maybe_msg" : "";
    my $msgstr = "times$forstr: " . join(", ", @$d) . "\n";
    if (my $out = $$args{out}) {
        if (ref($out) eq "ARRAY") {
            push @$out, $msgstr
        } elsif (ref($out) eq "SCALAR") {
            $$out = $msgstr
        } elsif (is_filehandle $out) {
            print $out $msgstr
        } else {
            warn "don't know how to output to '$out'";
        }
    } else {