PAX
view release on metacpan or search on metacpan
lib/PAX/CodeUnitCompiler.pm view on Meta::CPAN
return $body =~ /^\s*require\s+(?:[A-Za-z_][A-Za-z0-9_]*::)*\Q$class_tail\E\s*;/m ? 1 : 0;
}
sub _sibling_class {
my ($package, $class) = @_;
return $package if !defined $class || $class eq '';
return $package if !defined $package || $package eq '';
my ($root) = $package =~ m{^(.*)::([^:]+)$};
$root //= '';
my @class_parts = split m{::}, $class;
return join('::', grep { defined && $_ ne '' } $root, @class_parts);
}
sub _related_class_from_source {
my ($source, $package, $body, $class, %args) = @_;
return _sibling_class($package, $class) if !defined $class || $class eq '';
my @methods = @{ $args{methods} || [] };
for my $scope (grep { defined && $_ ne '' } $body, $source) {
my $qualified = _qualified_class_in_scope($scope, $class, \@methods);
lib/PAX/StandaloneDispatch.pm view on Meta::CPAN
region_id => $region->{region_id},
region_name => $region->{region_name},
guards => $region->{guards} // [],
deopt => $region->{deopt} // {},
},
args => [ $left + 0, $right + 0 ],
context => 'scalar',
);
if ($guard->{status} eq 'native_allowed' && $region->{executable_logical_path}) {
my $path = File::Spec->catfile($extract_dir, split m{/}, $region->{executable_logical_path});
my $result = $self->{native_runner}->run_i64_binary(
path => $path,
left => $left,
right => $right,
);
if (($result->{status} // '') eq 'ok') {
return {
status => 'native',
execution_model => 'standalone_packaged_native',
region_id => $region->{region_id},
lib/PAX/StandaloneDispatch.pm view on Meta::CPAN
my $stderr = <$err> // '';
waitpid($pid, 0);
die "standalone extraction failed for $image->{output_path}: $stderr\n" if ($? >> 8) != 0;
}
sub _runtime_paths {
my ($image, $extract_dir) = @_;
my $code_root = File::Spec->catdir($extract_dir, 'code');
my $runtime_root = File::Spec->catdir($extract_dir, 'runtime');
my $assets_root = File::Spec->catdir($extract_dir, 'assets');
my $entrypoint = File::Spec->catfile($code_root, split m{/}, $image->{entrypoint}{logical_path});
my $perl_exec = ($image->{runtime}{mode} // '') eq 'bundled_perl'
? File::Spec->catfile($runtime_root, split m{/}, ($image->{runtime}{perl_binary_logical_path} // 'bin/perl'))
: 'perl';
my @lib_roots = map { File::Spec->catdir($code_root, split m{/}) } @{ $image->{lib_dirs} // [] };
my @runtime_roots = map { File::Spec->catdir($runtime_root, split m{/}) } @{ $image->{runtime}{bundled_inc_roots} // [] };
return {
extract_dir => $extract_dir,
code_root => $code_root,
runtime_root => $runtime_root,
assets_root => $assets_root,
entrypoint => $entrypoint,
manifest_path => File::Spec->catfile($image->{standalone_dir}, 'manifest.json'),
perl_exec => $perl_exec,
perl5lib => join(':', grep { defined && length } (@lib_roots, @runtime_roots)),
};
}
sub _restore_executable_bits {
my ($image, $paths) = @_;
chmod 0700, $paths->{perl_exec} if ($image->{runtime}{mode} // '') eq 'bundled_perl' && -f $paths->{perl_exec};
for my $region (@{ $image->{native_dispatch} // [] }) {
next if !$region->{executable_logical_path};
my $path = File::Spec->catfile($paths->{extract_dir}, split m{/}, $region->{executable_logical_path});
chmod 0700, $path if -f $path;
}
}
sub _run_perl_region {
my (%args) = @_;
my $paths = $args{paths};
my $region = $args{region};
my $perl = $paths->{perl_exec};
my $script = q{
lib/PAX/StandaloneImage.pm view on Meta::CPAN
open STDERR, '>', File::Spec->devnull or die "cannot open devnull: $!";
exec {$entrypoint} $entrypoint, '--pax-standalone-extract', $extract_root;
exit 127;
}
waitpid($pid, 0);
return ($? >> 8) == 0 ? 1 : 0;
}
sub _extract_payload_path {
my ($root, $prefix, $logical_path) = @_;
my @parts = grep { defined && $_ ne '' } split m{/+}, ($logical_path // '');
return File::Spec->catfile($root, $prefix, @parts);
}
sub _extracted_manifest_path {
my ($root, $prefix, $logical_path) = @_;
my $path = _extract_payload_path($root, $prefix, $logical_path);
return '' if !defined $path || $path eq '' || !-f $path;
return $path;
}
lib/PAX/StandaloneImage.pm view on Meta::CPAN
make_path($rebuild_root) if !-d $rebuild_root;
my %written;
my $materialized_entrypoint = '';
for my $item (@source_items) {
my $source_path = $item->{source_path} // next;
my $bytes = $item->{source_bytes} // '';
next if $bytes eq '';
my $rel = File::Spec->abs2rel($source_path, $root);
next if !defined $rel || $rel eq '' || $rel =~ /^\.\.(?:\/|\\|$)/;
my $dest = File::Spec->catfile($rebuild_root, split m{/+|\\+}, $rel);
next if $written{$dest}++;
my ($vol, $dirs) = File::Spec->splitpath($dest);
make_path($dirs) if $dirs ne '' && !-d $dirs;
open my $fh, '>:raw', $dest or return {};
print {$fh} $bytes;
close $fh or return {};
if (($item->{unit_kind} // '') eq 'entrypoint') {
$materialized_entrypoint = $dest;
}
}
lib/PAX/StandaloneImage.pm view on Meta::CPAN
sub _materialized_manifest_roots {
my ($manifest, $field, $unit_kind, $source_root, $rebuild_root) = @_;
my @roots;
my %seen;
for my $logical_root (@{ $manifest->{$field} // [] }) {
next if !defined $logical_root || $logical_root eq '';
my $original_root = _manifest_source_root_for_logical($manifest, $logical_root, $unit_kind);
next if !defined $original_root || $original_root eq '';
my $rel = File::Spec->abs2rel($original_root, $source_root);
next if !defined $rel || $rel eq '' || $rel =~ /^\.\.(?:\/|\\|$)/;
my $materialized = File::Spec->catdir($rebuild_root, split m{/+|\\+}, $rel);
next if !-d $materialized || $seen{$materialized}++;
push @roots, $materialized;
}
return \@roots;
}
sub _common_source_parent {
my @paths = grep { defined && $_ ne '' } @_;
return '' if !@paths;
my @common = File::Spec->splitdir(dirname(shift @paths));
lib/PAX/StandaloneImage.pm view on Meta::CPAN
}
return File::Spec->catdir(@common);
}
sub _extracted_manifest_roots {
my ($root, $prefix, $logical_roots) = @_;
my @roots;
my %seen;
for my $logical_root (@{ $logical_roots // [] }) {
next if !defined $logical_root || $logical_root eq '';
my @parts = grep { defined && $_ ne '' } split m{/+}, $logical_root;
my $path = File::Spec->catdir($root, $prefix, @parts);
next if !-d $path || $seen{$path}++;
push @roots, $path;
}
return \@roots;
}
sub _original_manifest_roots {
my ($manifest, $field, $unit_kind) = @_;
my @roots;
lib/PAX/StandaloneImage.pm view on Meta::CPAN
my ($manifest, $logical_root, $unit_kind) = @_;
for my $unit (@{ $manifest->{code_units} // [] }) {
my $logical_path = $unit->{logical_path} // '';
my $source_path = $unit->{source_path} // '';
my $kind = $unit->{unit_kind} // '';
next if $logical_path eq '' || $source_path eq '';
next if defined $unit_kind && $unit_kind ne '' && $kind ne $unit_kind;
next if index($logical_path, $logical_root . '/') != 0;
my $rel = substr($logical_path, length($logical_root) + 1);
next if $rel eq '';
my @rel_parts = split m{/+}, $rel;
my @source_parts = File::Spec->splitdir(dirname($source_path));
splice @source_parts, -(@rel_parts - 1) if @rel_parts > 1;
my $root = File::Spec->catdir(@source_parts);
return $root if $root ne '';
}
return;
}
sub load {
my ($self, %args) = @_;
lib/PAX/StandaloneImage.pm view on Meta::CPAN
push @files, $path if !$seen{$path}++;
}
return @files;
}
sub _helper_module_path {
my ($rel, $roots) = @_;
return if !$rel;
for my $root (@{ $roots // [] }) {
next if !defined $root || $root eq '';
my $path = File::Spec->catfile($root, split m{/}, $rel);
return $path if -f $path;
}
return;
}
sub _probe_loaded_runtime_files {
my (%args) = @_;
my @modules = @{ $args{modules} // [] };
return () if !@modules;
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
return 0 if $entrypoint =~ /\A-/;
return 0 if $entrypoint =~ /\A\s*\z/;
return 1;
}
sub _resolve_entrypoint_from_manifest {
my ($entrypoint) = @_;
my $state = _state();
my $manifest_entrypoint = $state->{manifest}{entrypoint}{logical_path} // '';
if ($manifest_entrypoint ne '') {
my $candidate = File::Spec->catfile($state->{root}, 'code', split m{/}, $manifest_entrypoint);
return $candidate if -f $candidate;
}
my @unit_candidates = grep {
my $unit = $_;
my $unit_kind = $unit->{unit_kind} // '';
my $packaging = $unit->{packaging} // '';
($unit_kind // '') eq 'entrypoint' || ($packaging // '') =~ /\A(compiled|hybrid|residual)_(?:dispatch|cli_router|script)_pcu_v1\z/;
} @{ $state->{manifest}{code_units} // [] };
for my $unit (@unit_candidates) {
my $logical = $unit->{logical_path} // '';
next if $logical eq '';
my $candidate = File::Spec->catfile($state->{root}, 'code', split m{/}, $logical);
return $candidate if -f $candidate;
}
return;
}
sub _state {
return $STATE if $STATE;
my $manifest_path = $ENV{PAX_STANDALONE_MANIFEST_PATH} or die 'PAX_STANDALONE_MANIFEST_PATH not set';
open my $fh, '<', $manifest_path or die "cannot read $manifest_path: $!";
local $/;
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
sub _standalone_embedded_asset_path {
my ($name) = @_;
return if !defined $name || $name eq '';
my $state = _state();
for my $asset (@{ $state->{manifest}{assets} // [] }) {
next if ref($asset) ne 'HASH';
my $logical = $asset->{logical_path} // '';
next if $logical eq '';
next if $logical ne $name && $logical !~ m{(?:^|/)\Q$name\E\z};
my $path = File::Spec->catfile($state->{root}, 'assets', split m{/}, $logical);
return $path if -f $path;
}
return;
}
sub _share_dist_private_cli_dir {
my ($dist_name) = @_;
return if !defined $dist_name || $dist_name eq '';
my $ok = eval {
require File::ShareDir;
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
my $guard = PAX::GuardManager->new(
epochs => $state->{manifest}{runtime_epochs} // {},
)->validate_or_deopt({
region_id => $meta->{region_id},
region_name => $meta->{region_name},
guards => $meta->{guards} // [],
deopt => $meta->{deopt} // {},
}, args => [ @args[0, 1] ], context => 'scalar');
if (($guard->{status} // '') eq 'native_allowed') {
my $probe = File::Spec->catfile($state->{root}, split m{/}, $meta->{executable_logical_path});
chmod 0700, $probe if -f $probe;
my $result = $state->{native_runner}->run_i64_binary(
path => $probe,
left => $args[0],
right => $args[1],
);
if (($result->{status} // '') eq 'ok' && defined $result->{value}) {
_log_native_hit($full);
return $result->{value};
}
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
my ($args) = @_;
return 0 if @$args != 2;
return 0 if !defined $args->[0] || !defined $args->[1];
return ($args->[0] =~ /\A-?\d+\z/ && $args->[1] =~ /\A-?\d+\z/) ? 1 : 0;
}
sub _load_compiled_unit {
my ($unit) = @_;
my $state = _state();
_trace("load unit " . (($unit->{require_path} // $unit->{logical_path} // 'unknown')));
my $path = File::Spec->catfile($state->{root}, 'code', split m{/}, $unit->{logical_path});
open my $fh, '<', $path or die "cannot read compiled unit $path: $!";
local $/;
my $record = _runtime_json_decode(<$fh>);
if (($record->{residual_mode} // '') eq 'module') {
_load_residual_module($unit, $record);
return;
}
for my $init (@{ $record->{initializers} // [] }) {
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
}
if (@{ $record->{unsupported_subs} // [] }) {
_install_residual_stubs($unit, $record);
}
}
sub _ensure_virtual_source_file {
my ($unit) = @_;
my $state = _state();
my $logical = _virtual_source_logical_path($unit);
my $path = File::Spec->catfile($state->{root}, 'code', split m{/}, $logical);
return $path if -f $path;
my $dir = dirname($path);
make_path($dir) if !-d $dir;
open my $fh, '>', $path or die "cannot write virtual source file $path: $!";
print {$fh} "# PAX compiled unit placeholder for ", ($unit->{require_path} // $unit->{logical_path} // 'unknown'), "\n1;\n";
close $fh;
return $path;
}
sub _virtual_source_logical_path {
my ($unit) = @_;
my $logical = $unit->{logical_path} // '';
if (($unit->{require_path} // '') ne '') {
if ($logical =~ /\.pcu\.json\z/) {
$logical =~ s/\.pcu\.json\z/.pm/;
return $logical;
}
return File::Spec->catfile('virtual', split m{/}, ($unit->{require_path} // 'module.pm'));
}
if ($logical =~ /\.dashboard\.json\z/) {
$logical =~ s/\.dashboard\.json\z/.pl/;
return $logical;
}
if ($logical =~ /\.dispatch\.json\z/) {
$logical =~ s/\.dispatch\.json\z/.pl/;
return $logical;
}
if ($logical =~ /\.script\.json\z/) {
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
_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;
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
return $payload;
}
sub _find_code_unit_for_entrypoint {
my ($entrypoint) = @_;
my $state = _state();
my $entrypoint_name = $entrypoint;
for my $unit (@{ $state->{manifest}{code_units} // [] }) {
next unless $unit && ref($unit) eq 'HASH';
my $logical = $unit->{logical_path} // '';
my $packed = File::Spec->catfile($state->{root}, 'code', split m{/}, $logical);
return $unit if $unit->{logical_path} eq $entrypoint || $packed eq $entrypoint_name;
my $source_path = $unit->{source_path} // '';
next if $source_path eq '';
return $unit if File::Spec->rel2abs($source_path) eq File::Spec->rel2abs($entrypoint_name);
}
return;
}
sub _apply_initializer {
my ($init) = @_;
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
$impl = sub {
my ($self, $collector_name, $entry) = @_;
my ($timestamp) = $entry =~ /\A=== collector [^\n]* \| \@ ([0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}(?:Z|[+-][0-9]{4}|[+-][0-9]{2}:[0-9]{2}))(?: \| [^\n]*)* ===\n/;
die "Unable to parse collector log timestamp for $collector_name\n" if !defined $timestamp;
return _code_for($to_epoch_method)->($self, $timestamp);
};
return _install_sub_impl($package, $name, $sub->{prototype}, $impl);
}
if (($sub->{op} // '') eq 'collector_trim_log_by_age') {
my $split_method = $sub->{split_method} // die 'compiled sub split method missing';
my $entry_epoch_method = $sub->{entry_epoch_method} // die 'compiled sub entry-epoch method missing';
$impl = sub {
my ($self, $collector_name, $text, $retention_seconds, %args) = @_;
return $text if !defined $retention_seconds;
return $text if $text eq '';
my $now_epoch = defined $args{now_epoch} ? $args{now_epoch} : time;
my $cutoff = $now_epoch - $retention_seconds;
my @kept;
for my $entry (_code_for($split_method)->($self, $text)) {
my $entry_epoch = _code_for($entry_epoch_method)->($self, $collector_name, $entry);
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
};
return _install_sub_impl($package, $name, $sub->{prototype}, $impl);
}
if (($sub->{op} // '') eq 'skill_dispatcher_page_location') {
my $skill_lookup_roots_method = $sub->{skill_lookup_roots_method} // die 'compiled sub skill-lookup-roots method missing';
$impl = sub {
my ($self, $skill_name, $route_id) = @_;
return if !$skill_name || !$route_id;
for my $skill_path (_code_for($skill_lookup_roots_method)->($self, $skill_name)) {
my $file = File::Spec->catfile($skill_path, 'dashboards', split m{/+}, $route_id);
return ($file, $skill_path) if -f $file;
}
return;
};
return _install_sub_impl($package, $name, $sub->{prototype}, $impl);
}
if (($sub->{op} // '') eq 'skill_dispatcher_skill_bookmark_entries') {
my $skill_lookup_roots_method = $sub->{skill_lookup_roots_method} // die 'compiled sub skill-lookup-roots method missing';
$impl = sub {
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
if (($sub->{op} // '') eq 'skill_dispatcher_route_response') {
my $skill_layers_method = $sub->{skill_layers_method} // die 'compiled sub skill-layers method missing';
my $bookmark_entries_method = $sub->{bookmark_entries_method} // die 'compiled sub bookmark entries method missing';
my $page_response_method = $sub->{page_response_method} // die 'compiled sub page response method missing';
$impl = sub {
my ($self, %args) = @_;
my $skill_name = $args{skill_name} || '';
my $route = defined $args{route} ? $args{route} : '';
my @skill_layers = _code_for($skill_layers_method)->($self, $skill_name);
return [404, 'text/plain; charset=utf-8', "Skill '$skill_name' not found\n"] if !@skill_layers;
my @parts = grep { defined && $_ ne '' } split m{/+}, $route;
my @dashboards_roots = map { File::Spec->catdir($_, 'dashboards') } @skill_layers;
return [404, 'text/plain; charset=utf-8', "Skill '$skill_name' does not provide dashboards\n"]
if !grep { -d $_ } @dashboards_roots;
if (@parts && $parts[0] eq 'bookmarks') {
if (@parts == 1) {
my @items = _code_for($bookmark_entries_method)->($self, $skill_name);
return [404, 'text/plain; charset=utf-8', "Skill '$skill_name' does not provide dashboards\n"] if !@items;
return [200, 'application/json; charset=utf-8', JSON::XS::encode_json({ skill => $skill_name, bookmarks => \@items })];
}
my $legacy_id = join '/', @parts[1 .. $#parts];
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
my @patterns = @{ $args{patterns} || [] };
my ($basename) = $match_path =~ m{([^/\\]+)$};
$basename ||= $match_path;
my $stem = $basename;
$stem =~ s{\.[^.]+$}{};
my $rank = 0;
for my $pattern (@patterns) {
next if !defined $pattern || $pattern eq '';
my $regex = _code_for($compile_regex_method)->($pattern);
my $score = 50;
my @components = grep { defined && $_ ne '' } split m{[\\/]+}, $match_path;
if ($basename =~ /\A(?:$pattern)\z/i) {
$score = 0;
} elsif ($stem =~ /\A(?:$pattern)\z/i) {
$score = 1;
} elsif ($basename =~ /\A(?:$pattern)/i) {
$score = 2;
} elsif ($basename =~ $regex) {
$score = 3;
} elsif (grep { $_ =~ /\A(?:$pattern)\z/i } @components) {
$score = 4;
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
return _install_sub_impl($package, $name, $sub->{prototype}, $impl);
}
if (($sub->{op} // '') eq 'open_file_cached_archive_source_path') {
$impl = sub {
my (%args) = @_;
my $paths = $args{paths} || die 'Missing path registry';
my $archive = $args{archive} || die 'Missing archive path';
my $entry = $args{entry} || die 'Missing archive entry';
my $digest = Digest::MD5::md5_hex(join "\0", $archive, $entry);
my @parts = grep { defined && $_ ne '' } split m{/+}, $entry;
return File::Spec->catfile(
$paths->cache_root,
'open-file',
'java-sources',
$digest,
@parts,
);
};
return _install_sub_impl($package, $name, $sub->{prototype}, $impl);
}
lib/PAX/StandaloneRuntime.pm view on Meta::CPAN
return _interpret_native_shape($shape, \@args);
}
# Dispatch supported native-shape script subs through the runtime dispatcher and
# fall back to interpretation when no packaged artifact is available.
sub _invoke_native_shape_runtime {
my ($full, $shape, $args) = @_;
my $state = _state();
my $meta = $state->{by_region}{$full} || {};
return { status => 'fallback', reason => 'native region missing' } if !($meta->{executable_logical_path} // '');
my $probe = File::Spec->catfile($state->{root}, split m{/}, $meta->{executable_logical_path});
chmod 0700, $probe if -f $probe;
my $left = $args->[0];
my $right = @$args > 1 ? $args->[1] : 0;
return $state->{native_runner}->run_i64_binary(
path => $probe,
left => $left,
right => $right,
);
}
( run in 1.420 second using v1.01-cache-2.11-cpan-71847e10f99 )