view release on metacpan or  search on metacpan

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

    }
    return File::Spec->catfile('virtual', 'entrypoint.pl');
}

sub _run_entrypoint {
    my ($entrypoint) = @_;
    if ($entrypoint =~ /\.service\.json\z/) {
        return _run_service_dispatch_unit($entrypoint);
    }
    if ($entrypoint =~ /\.cli-router\.json\z/) {
        return _run_cli_router_unit($entrypoint);
    }
    if ($entrypoint =~ /\.dispatch\.json\z/) {
        return _run_dispatch_script_unit($entrypoint);
    }
    if ($entrypoint =~ /\.script\.json\z/) {
        return _run_script_unit($entrypoint);
    }
    my $rv = do $entrypoint;
    die $@ if $@;
    die "failed to load $entrypoint: $!" if !defined($rv) && $!;
    return $rv;
}

sub _run_service_dispatch_unit {
    my ($entrypoint) = @_;
    open my $fh, '<', $entrypoint or die "cannot read service dispatch unit $entrypoint: $!";
    local $/;
    my $record = _runtime_json_decode(<$fh>);

    my $cmd = shift(@ARGV);
    $cmd = 'version' if !defined($cmd) || $cmd eq '';

    if ($cmd eq 'version') {
        print(($record->{version} // '0.0.0') . "\n");
        exit 0;
    }

    if ($cmd eq 'serve') {
        (my $app_module_path = ($record->{app_module} // '')) =~ s{::}{/}g;
        $app_module_path .= '.pm' if $app_module_path ne '';
        (my $server_module_path = ($record->{server_module} // '')) =~ s{::}{/}g;
        $server_module_path .= '.pm' if $server_module_path ne '';
        _load_compiled_require($app_module_path) || require $app_module_path;
        require $server_module_path;
        my $host = '127.0.0.1';
        my $port = 5000;
        while (@ARGV) {
            my $arg = shift @ARGV;
            if ($arg eq '--host') {
                $host = shift @ARGV // die "--host requires a value\n";
                next;
            }
            if ($arg eq '--port') {
                $port = shift @ARGV // die "--port requires a value\n";
                next;
            }
            die "unexpected argument: $arg\n";
        }

        my $asset_root = $ENV{PAX_EMBEDDED_ASSET_ROOT}
            || File::Spec->catdir(dirname(_virtual_entrypoint_path($entrypoint)), '..', 'share');
        my $builder_method = $record->{builder_method} || 'build_psgi_app';
        my $app_module = $record->{app_module} || die "service dispatch missing app module\n";
        my $server_module = $record->{server_module} || die "service dispatch missing server module\n";
        my $app = $app_module->$builder_method(asset_root => $asset_root);
        my $server = $server_module->new;
        $server->run($app, {
            host => $host,
            port => $port,
            listen => ["$host:$port"],
            workers => 1,
        });
        return 0;
    }

    die "unknown command: $cmd\n";
}

sub _run_cli_router_unit {
    my ($entrypoint) = @_;
    open my $fh, '<', $entrypoint or die "cannot read cli router unit $entrypoint: $!";
    local $/;
    my $record = _runtime_json_decode(<$fh>);
    my $path = _virtual_entrypoint_path($entrypoint);
    my $bootstrap = $record->{bootstrap_source};
    if (defined $bootstrap && $bootstrap ne '') {
        my $wrapped = "package main;\n#line 1 \"$path\"\n" . $bootstrap;
        my $rv = eval $wrapped;
        die $@ if $@;
    }

    my $cmd = shift @ARGV || '';
    _code_for('main::_load_runtime_env')->() if _code_for('main::_load_runtime_env');
    _code_for('main::_prime_command_result_env')->($cmd, @ARGV)
        if $cmd ne '' && _code_for('main::_prime_command_result_env');

    if ($cmd eq '') {
        main::pod2usage(
            -exitval  => 1,
            -verbose  => 99,
            -sections => [qw(NAME SYNOPSIS)],
        );
    }
    elsif ($cmd eq 'help' || $cmd eq '--help' || $cmd eq '-h') {
        main::pod2usage(
            -exitval => 0,
            -verbose => 99,
        );
    }

    if ($cmd eq 'version') {
        my $version_module = $record->{version_module} || die "cli router missing version module\n";
        _load_package_by_module_name($version_module);
        no strict 'refs';
        print ${$version_module . '::VERSION'}, "\n";
        exit 0;
    }

    if (my $helper_path = _code_for('main::_builtin_helper_path')->($cmd)) {
        if (my $helper_name = _direct_standalone_helper_name_from_path($helper_path)) {

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

    if ($cmd ne '') {
        my $suggest_class = $record->{suggest_class} || die "cli router missing suggest class\n";
        print STDERR $suggest_class->new()->unknown_command_message($cmd);
    }

    main::pod2usage(
        -exitval  => 1,
        -verbose  => 99,
        -sections => [qw(NAME SYNOPSIS)],
    );
}

sub _run_dispatch_script_unit {
    my ($entrypoint) = @_;
    open my $fh, '<', $entrypoint or die "cannot read dispatch script unit $entrypoint: $!";
    local $/;
    my $record = _runtime_json_decode(<$fh>);
    my $path = _virtual_entrypoint_path($entrypoint);
    my $bootstrap = $record->{bootstrap_source};
    if (defined $bootstrap && $bootstrap ne '') {
        my $wrapped = "package main;\n#line 1 \"$path\"\n" . $bootstrap;
        my $rv = eval $wrapped;
        die $@ if $@;
    }
    my $cmd = shift(@ARGV);
    if (($record->{command_default_mode} // '') eq 'defined_or') {
        $cmd = $record->{command_default} if !defined $cmd;
    } else {
        $cmd = $record->{command_default} if !defined($cmd) || $cmd eq '';
    }
    for my $entry (@{ $record->{actions} // [] }) {
        next if ($entry->{command} // '') ne (defined $cmd ? $cmd : '');
        return _run_dispatch_action($entry->{action}, $cmd);
    }
    if (my $unknown = $record->{unknown_action}) {
        return _run_dispatch_action($unknown, $cmd);
    }
    die "no dispatch action for command " . (defined $cmd ? $cmd : '(undef)');
}

sub _run_dispatch_action {
    my ($action, $cmd) = @_;
    my $op = $action->{op} // die 'dispatch action op missing';
    if ($op eq 'print_call') {
        my $cv = _code_for($action->{target}) or die "missing dispatch target $action->{target}";
        my $value = $cv->(@{ $action->{args} // [] });
        print $value;
        print "\n" if $action->{newline};
        exit($action->{exit_code} // 0);
    }
    if ($op eq 'print_required_global') {
        my $module = $action->{require_module} // die 'dispatch require module missing';
        _load_package_by_module_name($module);
        no strict 'refs';
        my $value = ${ $action->{symbol} };
        print $value;
        print "\n" if $action->{newline};
        exit($action->{exit_code} // 0);
    }
    if ($op eq 'print_embedded_asset') {
        my $root = $ENV{PAX_EMBEDDED_ASSET_ROOT} // '';
        my $logical = $action->{logical_path} // die 'dispatch asset logical path missing';
        my $path = $root ? File::Spec->catfile($root, split m{/}, $logical) : '';
        if (!$path || !-f $path) {
            print STDERR "missing asset\n";
            exit 3;
        }
        open my $fh, '<', $path or die $!;
        local $/;
        my $content = <$fh>;
        close $fh;
        print $content;
        exit 0;
    }
    if ($op eq 'stderr_interpolate_cmd') {
        print STDERR ($action->{prefix} // '') . (defined $cmd ? $cmd : '') . ($action->{suffix} // '');
        exit($action->{exit_code} // 0);
    }
    die "unsupported dispatch action op: $op";
}

sub _run_script_unit {
    my ($entrypoint) = @_;
    open my $fh, '<', $entrypoint or die "cannot read script unit $entrypoint: $!";
    local $/;
    my $record = _runtime_json_decode(<$fh>);
    my $source = $record->{script_source} // _script_source_from_code_units($entrypoint)
        // _source_path_to_script_source($entrypoint)
        // _script_source_from_residual_payload($entrypoint);
    die "script source missing for $entrypoint" if !defined $source;
    die "script source is empty for $entrypoint" if $source eq '';
    $source = _apply_compiled_script_subs($source, $record->{compiled_subs} // []);
    my $path = _virtual_entrypoint_path($entrypoint);
    my $wrapped = "package main;\n#line 1 \"$path\"\n" . $source;
    my $rv = eval $wrapped;
    die $@ if $@;
    return 0 if !defined($rv);
    if (my $invocation = $record->{entry_invocation}) {
        my $op = $invocation->{op} // '';
        if ($op eq 'call_main_argv_and_exit') {
            my $cv = _code_for('main::main') or die "script unit $path missing main";
            exit(($cv->(@ARGV) // 0));
        }
        die "unsupported script entry invocation op: $op";
    }
    return $rv;
}

sub _script_source_from_code_units {
    my ($entrypoint) = @_;
    my $state = _state();
    my $unit = _find_code_unit_for_entrypoint($entrypoint);
    return if !$unit;
    return $unit->{script_source} if defined $unit->{script_source};
    my $bytes = $unit->{bytes};
    return if !defined $bytes;
    my $decoded = eval { _runtime_json_decode($bytes) };
    return $decoded->{script_source} if ref($decoded) eq 'HASH' && defined $decoded->{script_source};
    return $bytes;
}