view release on metacpan or  search on metacpan

script/plcost  view on Meta::CPAN

our $DATE = '2020-04-29'; # DATE
our $VERSION = '0.122'; # VERSION

use 5.010;
use strict;
use warnings;
#use Log::Any '$log';

use App::PlUtils;
use File::Which;
use Perinci::CmdLine::Any;

our %SPEC;
$SPEC{plcost} = {
    v => 1.1,
    summary => 'Run Perl script with Devel::EndStats',
    description => <<'_',



_
    args => {
        file => $App::PlUtils::arg_file_single,
        extra_args => {
            summary => 'Extra arguments to pass to script',
            schema  => ['array*', of=>'str*'],
            pos     => 1,
            greedy  => 1,
        },
        hide_core => {
            schema => 'bool',
        },
        sort => {
            schema => ['str*', in=>[map {($_,"-$_")}
                                        qw/file time caller order lines/]],
        },
        hide_noncore => {
            schema => 'bool',
        },
        show_memsize => {
            schema => 'bool',
        },
    },
};
sub plcost {
    my %args = @_;

    my $de_import = "verbose,1";
    $de_import .= ",hide_core,1" if $args{hide_core};
    $de_import .= ",hide_noncore,1" if $args{hide_noncore};
    $de_import .= ",show_memsize,1,sort,-memsize" if $args{show_memsize};
    $de_import .= ",sort,$args{sort}" if $args{sort};
    my @cmd = ($^X, "-MDevel::EndStats=$de_import");

    my $file = $args{file};
    if (!(-f $file) && $file !~ m!/!) {
        # search file in PATH
        $file = which($file);
    }
    unless (-f $file) {
        return [404, "No such file '$args{file}'"];
    }

    push @cmd, $file, @{ $args{extra_args} // [] };

    #$log->tracef("exec(%s)", \@cmd);
    exec @cmd;
    # [200]; # won't get reached
}

Perinci::CmdLine::Any->new(
    url => '/main/plcost',
    read_config => 0,
    read_env => 0,
)->run;

# ABSTRACT: Run Perl script with Devel::EndStats
# PODNAME: plcost

__END__

=pod

=encoding UTF-8

=head1 NAME

plcost - Run Perl script with Devel::EndStats

=head1 VERSION

This document describes version 0.122 of plcost (from Perl distribution App-PlUtils), released on 2020-04-29.

=head1 SYNOPSIS

 % plcost parse-id-phone

=head1 DESCRIPTION

=head1 OPTIONS

C<*> marks required options.

=head2 Main options

=over

=item B<--extra-args-json>=I<s>

Extra arguments to pass to script (JSON-encoded).

See C<--extra-args>.

=item B<--extra-args>=I<s@>

Extra arguments to pass to script.

Can be specified multiple times.

=item B<--file>=I<s>*