view release on metacpan or  search on metacpan

lib/PAX/CLI.pm  view on Meta::CPAN

use PAX::HIR;
use PAX::GuardedSSA;
use PAX::GuardManager;
use PAX::Tier1;
use PAX::ArtifactCache;
use PAX::Mode;
use PAX::Differential;
use PAX::Benchmark;
use PAX::NativeRunner;
use PAX::Corpus;
use PAX::RuntimeDispatcher;
use PAX::ProfileStore;
use PAX::Gatekeeper;
use PAX::InlineCache;
use PAX::BenchmarkMatrix;
use PAX::CoreSuite;
use PAX::CPANMatrix;
use PAX::AppImage;
use PAX::AppServer;
use PAX::Paxfile;
use PAX::StandaloneImage;
use PAX::StandaloneDispatch;

sub run {
    my ($class, @argv) = @_;
    my $command = shift @argv // 'help';

    if ($command eq 'run') {
        return $class->_run(@argv);
    }
    if ($command eq 'build') {
        return $class->_build(@argv);
    }
    if ($command eq 'help' || $command eq '--help' || $command eq '-h') {
        print _usage();
        return 0;
    }
    if ($class->_looks_like_interpreter_script($command)) {
        return $class->_run_interpreter_script($command, @argv);
    }

    print STDERR "unknown command: $command\n";
    print STDERR _usage();
    return 2;
}

# Treat a plain script path as interpreter-mode execution so a built pax binary
# can be used directly from a shebang line.
sub _looks_like_interpreter_script {
    my ($class, $candidate) = @_;
    return 0 if !defined $candidate || $candidate eq q{};
    return 0 if $candidate =~ /\A-/;
    return -f $candidate ? 1 : 0;
}

# Execute a shebang-target script as package main while preserving the expected
# process-facing script path and argument vector.
sub _run_interpreter_script {
    my ($class, $script, @argv) = @_;
    my $script_path = File::Spec->rel2abs($script);
    local @ARGV = @argv;
    local $0 = $script_path;
    require FindBin;
    local $FindBin::Bin;
    local $FindBin::RealBin;
    local $FindBin::Script;
    local $FindBin::RealScript;
    FindBin::again();

    my $runner = sub {
        package main;
        my ($path) = @_;
        return do $path;
    };

    my $rv = $runner->($script_path);
    if (!defined $rv) {
        my $error = $@ || $! || "unknown interpreter failure";
        print STDERR "pax interpreter failed for $script_path: $error\n";
        return 255;
    }

    return 0;
}

sub _run {
    my ($class, @argv) = @_;
    return $class->_run_standalone(@argv);
}

sub _run_dispatch {
    my ($class, @argv) = @_;
    my ($left, $right, $region, $pretty, $entrypoint) = (10, 32, undef, 1);
    while (@argv) {
        my $arg = shift @argv;
        if ($arg eq '--left') {
            $left = shift @argv // return _missing('--left');
            next;
        }
        if ($arg eq '--right') {
            $right = shift @argv // return _missing('--right');
            next;
        }
        if ($arg eq '--region') {
            $region = shift @argv // return _missing('--region');
            next;
        }
        if ($arg eq '--compact') {
            $pretty = 0;
            next;
        }
        if (!defined $entrypoint) {
            $entrypoint = $arg;
            next;
        }
        print STDERR "unexpected argument: $arg\n";
        return 2;
    }
    if (!defined $entrypoint) {
        print STDERR "run requires a Perl entrypoint\n";
        return 2;