view release on metacpan or  search on metacpan

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

            $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});
        }

        log_trace("Running benchmark with %s (precision=%g) ...", $runner, $precision);

        my @columns        = ('seq'  , 'participant', 'dataset');
        my @column_aligns  = ('right', 'left'       , 'left');
        my @column_formats = (undef  , undef        , undef);
        my @rows;
        my %arg_size_columns;
        if ($args{multiperl} || $args{multimodver}) {
            require Data::Clone;
            require Devel::Size;
            my %perl_exes;
            my %perl_opts;
            for my $it (@$items) {
                $perl_exes{$it->{perl}} = $it->{_perl_exe};
                $perl_opts{$it->{modver}} = $it->{_perl_opts} if defined $it->{modver};
            }
            if (!keys(%perl_opts)) {
                $perl_opts{""} = [];
            }

            my $sc = Data::Clone::clone($parsed);
            for (keys %$sc) { delete $sc->{$_} if /^(before|after)_/ } # remove all hooks

            my %item_mems; # key = item seq
            for my $perl (sort keys %perl_exes) {
                for my $modver (sort keys %perl_opts) {
                    my $scd_path = _get_tempfile_path(\%args, "scenario-$perl");
                    $sc->{items} = [];
                    for my $it (@$items) {
                        next unless $it->{perl} eq $perl;
                        next unless !length($it->{modver}) ||
                            $it->{modver} eq $modver;
                        next if $item_mems{$it->{seq}}++; # avoid duplicate item
                        if (defined $it->{_code_str}) {
                            delete $it->{_code}; # we'll be using _code_str
                        } else {
                            die "BUG: Can't dump scenario: no _code_str"; # shouldn't happen
                        }
                        push @{$sc->{items}}, $it;