view release on metacpan or  search on metacpan

lib/Bencher/Backend.pm  view on Meta::CPAN

        if ($action eq 'show-items-outputs') {
            die "show-items-outputs currently not supported on multiperl or multimodver\n" if $args{multiperl} || $args{multimodver};
            if ($is_cli_and_text_format) {
                $envres->[3]{'cmdline.skip_format'} = 1;
                $envres->[2] = join(
                    "",
                    map {(
                        "#", _item_label(item=>$_, bencher_args=>\%args), " stdout (", length($_->{_stdout} // ''), " bytes):\n",
                        ($_->{_stdout} // ''),
                        "\n\n",
                        "#", _item_label(item=>$_, bencher_args=>\%args), " stderr (", length($_->{_stderr} // ''), " bytes):\n",
                        ($_->{_stderr} // ''),
                        "\n\n",
                    )} @$items
                );
            } else {
                $envres->[2] = [map {$_->{_result_size}} @$items];
            }
            goto RETURN_RESULT;
        }

        # at this point, action = bench

        my $precision;
        if ($runner eq 'Benchmark') {
            $precision = $args{precision} // -0.5;
            if (defined $args{precision_limit}) {
                if ($precision < 0) {
                    if ($precision < $args{precision_limit}) {
                        $precision = $args{precision_limit};
                    }
                } else {
                    if ($precision > $args{precision_limit}) {
                        $precision = $args{precision_limit};
                    }
                }
            }
        } elsif ($runner eq 'Benchmark::Dumb::SimpleTime') {
            $precision = $args{precision} // 1;
            return [400, "When running with runner '$runner', precision must be an integer >= 1"]
                unless $precision =~ /\A[1-9][0-9]*\z/;
            if (defined $args{precision_limit}) {
                return [400, "When running with runner '$runner', precision_limit must be an integer >= 1"]
                    unless $args{precision_limit} =~ /\A[1-9][0-9]*\z/;
                if ($precision > $args{precision_limit}) {
                    $precision = $args{precision_limit};
                }
            }
        } else {
            $precision = $args{precision} //
                ($module_startup ? $parsed->{module_startup_precision} : undef) //
                $parsed->{precision} // $parsed->{default_precision} // 0;
            if (defined($args{precision_limit}) && $precision < $args{precision_limit}) {
                $precision = $args{precision_limit};
            }
        }

        if ($runner eq 'Benchmark') {
            die "Bench with Benchmark.pm currently does not support on multiperl or multimodver\n" if $args{multiperl} || $args{multimodver};
            my %codes;
            my %legends;
            for my $it (@$items) {
                my $key = $it->{_succinct_name};
                if (!length($key)) {
                    $key = $it->{seq};
                }
                if (exists $codes{$key}) {
                    $key .= " #$it->{seq}";
                }
                $codes{$key} = $it->{_code};
                $legends{$key} = join(
                    " ", map {"$_=$it->{$_}"}
                        grep { !/^_/ }
                            sort keys %$it
                        );
            }
            log_trace "Running benchmark with Benchmark.pm ...";
            my ($stdout, @res) = &Capture::Tiny::capture_stdout(
                sub {
                    Benchmark::cmpthese($precision, \%codes);
                    print "\n";
                    print "Legends:\n";
                    for (sort keys %legends) {
                        print "  ", $_, ": ", $legends{$_}, "\n";
                    }
                });
            $envres->[3]{'cmdline.skip_format'} = 1;
            $envres->[2] = $stdout;
            goto RETURN_RESULT;
        }

        my $time_start = Time::HiRes::time();
        if ($return_meta) {
            $envres->[3]{'func.bencher_version'} = $Bencher::VERSION;
            $envres->[3]{'func.bencher_args'} = {
                map {$_=>$args{$_}} grep {!/\A-/} keys %args};
            if ($args{scenario_file}) {
                $envres->[3]{'func.scenario_file'} = $args{scenario_file};
                my @st = stat($args{scenario_file});
                $envres->[3]{'func.scenario_file_mtime'} = $st[9];
                my $digests = _digest($args{scenario_file});
                $envres->[3]{'func.scenario_file_md5sum'} = $digests->{md5};
                $envres->[3]{'func.scenario_file_sha1sum'} = $digests->{sha1};
                $envres->[3]{'func.scenario_file_sha256sum'} = $digests->{sha256};
            } elsif (my $mod = $args{scenario_module}) {
                no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
                $mod = "Bencher::Scenario::$mod" unless $mod =~ /\ABencher::Scenario::/;
                $envres->[3]{'func.scenario_module'} = $mod;
                (my $mod_pm = "$mod.pm") =~ s!::!/!g;
                $INC{$mod_pm} or die "BUG: Can't find '$mod_pm' in \%INC";
                my @st = stat($INC{$mod_pm});
                $envres->[3]{'func.scenario_module_mtime'} = $st[9];
                my $digests = _digest($INC{$mod_pm});
                $envres->[3]{'func.scenario_module_md5sum'} = $digests->{md5};
                $envres->[3]{'func.scenario_module_sha1sum'} = $digests->{sha1};
                $envres->[3]{'func.scenario_module_sha256sum'} = $digests->{sha256};
                $envres->[3]{'func.module_versions'}{$mod} =
                    ${"$mod\::VERSION"};
            } elsif (my $mod0 = $args{cpanmodules_module}) {
                no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
                my $mod = "Acme::CPANModules::$mod0";
                $envres->[3]{'func.cpanmodules_module'} = $mod;
                (my $mod_pm = "$mod.pm") =~ s!::!/!g;
                my @st = stat($INC{$mod_pm});
                $envres->[3]{'func.cpanmodules_module_mtime'} = $st[9];
                my $digests = _digest($INC{$mod_pm});
                $envres->[3]{'func.cpanmodules_module_md5sum'} = $digests->{md5};
                $envres->[3]{'func.cpanmodules_module_sha1sum'} = $digests->{sha1};
                $envres->[3]{'func.cpanmodules_module_sha256sum'} = $digests->{sha256};
                $envres->[3]{'func.module_versions'}{$mod} =
                    ${"$mod\::VERSION"};
            }
            $envres->[3]{'func.sysload_before'} = [Sys::Load::getload()]
                if $INC{"System/Load.pm"};
            $envres->[3]{'func.time_start'} = $time_start;
        }

        $envres->[3]{'func.precision'} = $precision if $return_meta;

        if ($parsed->{env_hashes}) {
            require Data::Clone;
            $envres->[3]{'func.scenario_env_hashes'} =
                Data::Clone::clone($parsed->{env_hashes});
        }