Alien-Xrepo
view release on metacpan or search on metacpan
lib/Alien/Xrepo.pm view on Meta::CPAN
use v5.40;
use feature 'class';
no warnings 'experimental::class';
#
class Alien::Xrepo v1.0.10 {
use Alien::Xmake;
use Alien::Xrepo::PackageInfo;
use JSON::PP;
use Digest::SHA qw[sha1_hex];
use File::Copy qw[move];
use File::Temp ();
use Path::Tiny;
use Config;
use Capture::Tiny qw[capture capture_merged];
use Cwd ();
#
# Guards for the throwaway package files written for `system` installs; each File::Temp::Dir removes its
# directory on DESTROY, so they are parked here for the life of the object.
field $pkgfile_guards : param //= [];
field $verbose : param //= 0;
field $diagnosis : param //= 0;
field $root : param //= undef;
field $theme : param //= 'plain';
# Auto-confirm interactive xrepo/xmake prompts (e.g. -y / --confirm=yes). Useful when output is captured so a
# prompting install never hangs waiting on stdin.
field $yes : param //= 0;
field $confirm : param //= ();
field $xmake = Alien::Xmake->new;
# Default package kind (-k) for every action; a per-call `kind` wins. undef omits -k so installs match a bare
# `xrepo` command, matching cd52e9b behavior.
field $kind : param //= ();
# Warm-start resolution cache. install() memorizes a successful fetch result under this instance's store so a
# repeat launch skips xrepo entirely. Entries are LRU-bounded and a hit is only trusted while its recorded install
# dir still exists. Pass cache => 0 to disable (pure fetch-first behavior, one spawn per launch).
field $cache : param //= 1;
# Resolve which package store a call should operate on. A per-call `installdir` wins, then the `root` handed to the
# constructor, then whatever xrepo/the environment chooses (global store).
method _store_dir (%opts) { return $opts{installdir} // $root }
method blah ($msg) { return unless $verbose; say $msg; }
# Echo every command we are about to run
method _debug_cmd (@cmd) {
my $str = join( ' ', map { /\s/ ? qq{"$_"} : $_ } @cmd );
my @env;
push @env, "XMAKE_THEME=$ENV{XMAKE_THEME}" if defined $ENV{XMAKE_THEME};
push @env, "XMAKE_PKG_INSTALLDIR=$ENV{XMAKE_PKG_INSTALLDIR}" if defined $ENV{XMAKE_PKG_INSTALLDIR};
push @env, "XMAKE_PKG_CACHEDIR=$ENV{XMAKE_PKG_CACHEDIR}" if defined $ENV{XMAKE_PKG_CACHEDIR};
my $env = @env ? ' [ENV ' . join( ' ', @env ) . ']' : '';
say "[XREPO] $str$env (cwd: @{[ Cwd::getcwd() ]})\n" if $verbose;
return;
}
# Compose the full xrepo spec for a package: `<pkg> <version>` when pinned,
# the bare name otherwise. One argv element either way, so a version never
# splits on whitespace.
method _full_spec ( $pkg_spec, $version ) {
return defined $version && length $version ? "$pkg_spec $version" : $pkg_spec;
}
method install ( $pkg_spec, $version //= (), %opts ) {
my $full_spec = $self->_full_spec( $pkg_spec, $version );
local $ENV{XMAKE_THEME} = $self->_theme(%opts);
local $ENV{XMAKE_PKG_INSTALLDIR} = $self->_store_dir(%opts) if defined $self->_store_dir(%opts);
local $ENV{XMAKE_PKG_CACHEDIR} = $opts{cachedir} if defined $opts{cachedir};
# An install that wants system packages is driven through a generated package file instead of a bare spec,
# because xrepo's shim decides `system` for us otherwise (see _package_file). The common arguments for
# install and fetch: the mutating install gets an implicit -y unless the caller opted out; fetch is query-only,
# so no confirm. configs ride along in the package file when there is one, since the shim drops --extra there.
# The install also carries the optional -v/-D verbosity flags (see _verbosity_args); they are only added here
# because install is the one action whose output is not captured and parsed.
my $pkgfile = $self->_package_file( $full_spec, \%opts );
my @args = (
$self->_confirm_args( \%opts ),
$self->_build_args( defined $pkgfile ? { %opts, configs => undef } : \%opts ),
$self->_verbosity_args( \%opts ),
);
say "[*] xrepo: ensuring $full_spec is installed..." if $verbose;
# Warm path: a prior successful install+fetch is replayed straight from disk, so a repeat launch (eg/webui.pl)
# skips xrepo entirely. The LRU is validated against the recorded files (install dir and, when recorded, the
# first lib) before an entry is trusted.
my $use_cache = defined $opts{cache} ? $opts{cache} : $cache;
my $key = $use_cache ? $self->_cache_key( $full_spec, \%opts ) : undef;
my $meta = $use_cache ? ( $self->_cache_load(%opts) || { order => [], entries => {} } ) : undef;
if ( $meta && defined $key ) {
if ( my $hit = $self->_cache_get( $key, $meta ) ) {
my $info = eval { $self->_process_info( decode_json( $hit->{json} ) ) };
if ( ref $info ) {
$self->_guard_store( $info, %opts );
$self->_cache_save( $meta, %opts );
return $info;
}
}
}
# Fetch-first: an already-installed package answers with real paths immediately, so the mutating install is
# skipped (and the result is memorized for next launch).
my ( $data, $err ) = $self->_try_fetch( $full_spec, \%opts );
if ( defined $data && $self->_info_installed($data) ) {
say "[*] xrepo: $full_spec already installed, reusing fetch result..." if $verbose;
if ( $meta && defined $key ) {
$self->_cache_put( $key, $meta, $self->_cache_entry($data) );
$self->_cache_save( $meta, %opts );
}
return $self->_finalize( $data, %opts );
}
# Cold path: install, then fetch (which must succeed, since it tells us where things land).
my @install_cmd = $self->_argv( 'install', \@args, defined $pkgfile ? $pkgfile : $full_spec );
$self->_debug_cmd(@install_cmd);
$self->blah("Running: @install_cmd");
eval { system @install_cmd };
if ( my $spawn_err = $@ ) {
chomp $spawn_err;
die "xrepo install failed for $full_spec\n" .
" command: @install_cmd\n" .
( $^O eq 'MSWin32' ? " win32: $^E\n" : () ) .
" error: $spawn_err\n";
}
if ( $? != 0 ) {
die "xrepo install failed for $full_spec\n" . " command: @install_cmd\n" . " exit: " . ( $? >> 8 ) . "\n";
}
say "[*] xrepo: fetching paths..." if $verbose;
my $fresh = $self->_require_fetch( $full_spec, \%opts, $err );
if ( $meta && defined $key ) {
$self->_cache_put( $key, $meta, $self->_cache_entry($fresh) );
$self->_cache_save( $meta, %opts );
}
$self->_finalize( $fresh, %opts );
}
# LRU cap on cached resolutions. Entries are just the fetch JSON plus its install dir, so the bound keeps the file
# a few hundred KB even after a long debugging session.
sub _CACHE_MAX () {64}
# Where the resolution cache lives: alongside the caller's/instance's store when one is set, else the xmake global
# dir (~/.xmake) that xrepo itself uses for the default per-user store.
method _cache_dir (%opts) {
my $store = $self->_store_dir(%opts);
return path($store)->child('.alien-xmake') if defined $store && length $store;
my $home = $ENV{XMAKE_GLOBALDIR};
$home //= $ENV{HOME};
if ( !defined $home || !length $home ) {
$home = $^O eq 'MSWin32' ? "$ENV{HOMEDRIVE}$ENV{HOMEPATH}" : ();
}
return () if !defined $home || !length $home;
path($home)->child( '.xmake', '.alien-xmake' );
}
# Cache identity: everything that can move the installed layout. configs values run through the same boolean
# stringifier as the CLI, so built-in true/false produce a stable key.
method _cache_key ( $full_spec, $opts ) {
my @parts = ( $full_spec, $opts->{kind} // '', $opts->{plat} // '', $opts->{arch} // '', $opts->{mode} // '' );
# The private-build path and the system path can resolve a different package layout (one lands in this store,
# the other may be satisfied from outside it), so they must not share a cache entry.
push @parts, 'system' if $opts->{system};
if ( my $c = $opts->{configs} ) {
my $str = ref $c eq 'HASH' ? join( ',', map { "$_=" . Alien::Xmake::_bool_str( $c->{$_} ) } sort keys %$c ) : "$c";
push @parts, $str;
}
sha1_hex( join( "\0", @parts ) );
}
method _cache_load (%opts) {
my $dir = $self->_cache_dir(%opts) or return ();
my $file = $dir->child('cache.json');
return () unless -f $file;
my $raw = eval { $file->slurp_utf8 };
return () unless defined $raw && length $raw;
my $meta = eval { decode_json($raw) };
return () unless ref $meta eq 'HASH' && ref $meta->{order} eq 'ARRAY' && ref $meta->{entries} eq 'HASH';
$meta;
}
method _cache_save ( $meta, %opts ) {
my $dir = $self->_cache_dir(%opts) or return;
my ( @order, %keep );
for my $k ( @{ $meta->{order} // [] } ) {
my $e = $meta->{entries}{$k} or next;
next unless $self->_entry_alive($e);
push @order, $k;
$keep{$k} = $e;
}
while ( @order > _CACHE_MAX() ) { delete $keep{ pop @order }; }
$dir->mkpath;
my $file = $dir->child('cache.json');
my $tmp = $dir->child('cache.json.tmp');
$tmp->remove if $tmp->exists; # clear a tmp stranded by an interrupted save
$tmp->spew_utf8( encode_json( { version => 1, order => \@order, entries => \%keep } ) );
$file->remove if $^O eq 'MSWin32' && $file->exists;
move( "$tmp", "$file" );
}
method _entry_alive ($e) {
return () unless ref $e eq 'HASH';
lib/Alien/Xrepo.pm view on Meta::CPAN
}
}
# Build Includes. xrepo splits the `--includes` value on the OS path separator and rejoins with path.joinenv
# into XMAKE_RCFILES, the contents of which are textually PREPENDED to the temp project xmake.lua. Only genuine
# root-scope rc content (add_toolchains, etc.) belongs here: a vendored *package recipe* (package() {...}) is
# invalid in that scope and dies with e.g. "unknown interface: add_rules()", so recipe overrides are not supported.
my @rc;
if ( my $i = $opts->{includes} ) {
my @incs = ref $i eq 'ARRAY' ? @$i : split( /\Q$Config{path_sep}\E/, $i );
push @rc, map { path($_)->absolute->stringify } @incs;
push @args, '--includes=' . join( $Config{path_sep}, @rc ) if @rc;
}
# Extra per-action flags (e.g. --json, --cflags, --ldflags)
push @args, @$extra;
return @args;
}
# Theme used for xmake/xrepo output. Defaults to 'plain' (no ANSI); callers may pass `theme =>` per-call, or
# `theme =>` to the constructor. xmake reads $ENV{XMAKE_THEME}.
method _theme (%opts) { $opts{theme} // $theme }
# Assemble a full xrepo CLI argv
method _ensure_working_project () {
return unless $^O eq 'MSWin32';
my $tmp = $ENV{TEMP};
return unless defined $tmp && length $tmp && -d $tmp;
my ( undef, undef, undef, $mday, $mon, $year ) = localtime;
my $work = path($tmp)->child( '.xmake', sprintf( '%02d%02d%02d', $year % 100, $mon + 1, $mday ), 'xrepo', 'working' );
$work->mkpath;
my $xmake_lua = $work->child('xmake.lua');
if ( !$xmake_lua->exists || $xmake_lua->slurp =~ /\$\{/ ) {
# A failed create leaves a read-only raw template here; Path::Tiny's spew renames over it and dies
# Permission denied, so unlink first.
$xmake_lua->remove if $xmake_lua->exists;
$xmake_lua->spew(<<~'add_rules');
add_rules("mode.debug", "mode.release")
target("working")
set_kind("binary")
add_files("src/*.cpp")
add_rules
my $main = $work->child( 'src', 'main.cpp' );
$work->child('src')->mkpath unless $main->parent->is_dir;
$main->spew("int main() { return 0; }\n") unless $main->exists;
return;
}
}
method _ensure_templates_available() {
return unless $^O eq 'MSWin32';
my $exe = eval { $xmake->exe };
return unless defined $exe && length $exe && -e $exe;
my $src = path($exe)->parent->child('templates');
return unless $src->is_dir;
# ExtUtils::Install ships these as 0444, and on Windows that attribute survives xmake's
# {writeable=true} copy, so `xmake create` dies "cannot open file ... Permission denied" while
# rewriting the copied xmake.lua. The installed tree under perl/lib should stay read-only, so mirror
# the built-in templates into the user's writable xmake global dir instead -- <globaldir>/templates,
# xmake's own per-user override, which it resolves before <programdir>/templates. Seeded once per
# installed xmake version; an upgrade recopies the mirror wholesale.
#
# The global dir comes from xmake itself: its `~` mapping (LOCALAPPDATA on Windows) and the
# %APPDATA% legacy fallback are not portable to replicate in Perl, but `lua -c` prints the very
# directory create will consult. Single-quoted Lua strings only: win32's naive argv quoting mangles
# embedded double quotes (which surfaces as a bogus "Can't spawn" warning and exit 255).
my $script = q{import('core.base.global'); print('XREPO_GLOBALDIR=' .. global.directory())};
my $lines = capture { system $exe, 'lua', '-c', $script };
my ($gldir) = $lines =~ /^XREPO_GLOBALDIR=(.+)$/m;
return unless defined $gldir;
$gldir =~ s/\s+$//;
my $dst = path($gldir)->child('templates');
$dst->mkpath;
my $marker = $dst->child('.alien-xrepo-synced');
my $ver = eval { $xmake->_getver } // '';
my $synced = $marker->exists ? $marker->slurp : '';
return if length $synced && ( !length $ver || $synced eq "$ver\n" );
$src->visit(
sub {
my $file = shift;
return if $file->is_dir;
my $to = $dst->child( $file->relative($src) );
$to->parent->mkpath;
# Windows copies carry the source's read-only attribute with them, so force the per-user mirror
# writable (it lives in <globaldir>/templates, xmake's own mutable per-user template override).
$file->copy($to);
$to->chmod( $to->stat->mode | 0200 );
},
{ recurse => 1 }
);
$marker->spew("$ver\n");
}
method _argv ( $action, $flags, @spec ) {
$self->_ensure_working_project;
$self->_ensure_templates_available;
@spec = grep {defined} @spec;
return ( $xmake->exe, qw[lua private.xrepo], $action, @$flags, @spec );
}
# Actions that mutate the package store auto-confirm (-y) unless the caller explicitly opts out. The constructor's
# `yes =>` (or a per-call `yes =>` / `confirm =>`) is honored by _build_args; this covers the "caller said nothing"
# case so a captured install never hangs on an interactive prompt.
method _confirm_args ($opts) {
return ('-y') if !$yes && !exists $opts->{yes} && !( defined $opts->{confirm} && length $opts->{confirm} );
return ();
}
# xmake prints only the tail of a failed package's log and then points at the full install.txt (which lives on the
# build machine and is gone by the time a CPAN tester's report reaches you). `-v`/--verbose makes it print the whole
# log to the console and `-D`/--diagnosis adds the diagnostic detail; xrepo's install action forwards both to the
# inner `xmake require` (see xmake/modules/private/xrepo/action/install.lua), so they belong on *this* command line.
# install is the only action that runs uncaptured, so the flags are deliberately kept out of _build_args: the
# JSON-returning actions (fetch/info/scan/...) would have their parsed output polluted by the extra verbosity.
method _verbosity_args ($opts) {
my @args;
push @args, '-v' if $opts->{verbose} // $verbose;
push @args, '-D' if $opts->{diagnosis} // $diagnosis;
return @args;
}
# Run `xrepo fetch` and return a parsed PackageInfo (or raw flags).
method fetch ( $pkg_spec, $version //= (), %opts ) {
my $full_spec = $self->_full_spec( $pkg_spec, $version );
local $ENV{XMAKE_THEME} = $self->_theme(%opts);
local $ENV{XMAKE_PKG_INSTALLDIR} = $self->_store_dir(%opts) if defined $self->_store_dir(%opts);
local $ENV{XMAKE_PKG_CACHEDIR} = $opts{cachedir} if defined $opts{cachedir};
my @extra;
# Raw flag modes: return the string directly instead of a PackageInfo
my $flags_mode = $opts{cflags} || $opts{ldflags};
push @extra, '--cflags' if $opts{cflags};
push @extra, '--ldflags' if $opts{ldflags};
push @extra, '--deps' if $opts{deps};
push @extra, '--system' if $opts{system};
push @extra, '-e' if $opts{external};
my @args = ( '--json', $self->_build_args( \%opts, \@extra ) );
my @fetch_cmd = $self->_argv( 'fetch', \@args, $full_spec );
$self->blah("Running: @fetch_cmd");
my ( $json_out, $json_err, $json_exit ) = capture { system @fetch_cmd };
return if $json_exit != 0;
# cflags/ldflags mode: xrepo returns a plain flag string, not JSON
return $json_out if $flags_mode;
$self->blah("Raw fetch output:\n$json_out");
lib/Alien/Xrepo.pm view on Meta::CPAN
$r{scope} = $self->_path_under( $r{path}, @store ) ? 'store' : $self->_path_under( $r{path}, @system ) ? 'system' : 'host';
}
else {
$r{name} = $dep;
$r{scope} = $self->_looks_system_lib($dep) ? 'system' : 'unresolved';
}
push @out, \%r;
}
return \@out;
}
# Directories to offer the loader when resolving a library's dependency table, plus the install roots used to
# recognise a resolved path as "ours". Input is a list of fetch/closure entries (each with an optional
# artifacts.installdir and libfiles / linkdirs / bindirs). Returns (\@search_dirs, \@store_dirs).
method dep_search_dirs ($entries) {
my ( @search, @store, %seen );
my $add = sub { my $d = shift; return unless defined $d && length $d; push @search, $d unless $seen{$d}++ };
for my $e ( grep { ref $_ eq 'HASH' } @{ $entries // [] } ) {
my $id = $e->{artifacts}{installdir};
if ( defined $id && length $id ) {
push @store, $id;
$add->( path($id)->child($_)->stringify ) for qw[bin lib];
}
for my $key (qw[libfiles linkdirs bindirs]) {
my $v = $e->{$key} // [];
$v = [$v] unless ref $v eq 'ARRAY';
for my $p (@$v) {
next unless defined $p && length $p;
$add->( $key eq 'libfiles' ? path($p)->parent->stringify : $p );
}
}
}
return ( \@search, \@store );
}
# True when $child is $dir itself or sits underneath it (separator-bounded, case-insensitive on Windows).
method _path_under ( $child, @dirs ) {
my $c = path($child)->absolute->stringify;
($c) = ( $c =~ s{\\}{/}gr );
$c = lc $c if $^O eq 'MSWin32';
for my $dir (@dirs) {
next unless defined $dir && length $dir;
my $d = path($dir)->absolute->stringify;
($d) = ( $d =~ s{\\}{/}gr );
$d = lc $d if $^O eq 'MSWin32';
return 1 if index( $c, $d ) == 0 && ( length($c) == length($d) || substr( $c, length($d), 1 ) eq '/' );
}
return 0;
}
# Default OS locations whose libraries the loader already finds without help.
method _system_lib_dirs () {
if ( $^O eq 'MSWin32' ) {
my $root = $ENV{SystemRoot} // 'C:\\Windows';
return grep {-d} map { path($root)->child($_)->stringify } qw[System32 SysWOW64];
}
if ( $^O eq 'darwin' ) {
return grep {-d} qw[/usr/lib /usr/lib/system /System/Library/Frameworks /System/Library/PrivateFrameworks /Library/Frameworks];
}
my @dirs = qw[/lib /lib64 /usr/lib /usr/lib64 /usr/local/lib /usr/local/lib64];
push @dirs, grep {-d} glob('/lib/*-linux-gnu'), glob('/usr/lib/*-linux-gnu');
return grep {-d} @dirs;
}
# A bare loader name the OS itself provides: the Windows API sets/CRT, Mach-O system install names, and the
# usual ELF runtime sonames. Anything else that stayed unresolved is worth reporting.
method _looks_system_lib ($name) {
if ( $^O eq 'MSWin32' ) {
return 1 if $name =~ /\A(?:api-ms-win-|ext-ms-)/i;
my $sys
= qr/\A(?:ucrtbase|vcruntime\d*|msvcp\d*|msvcr\d*|kernel32|kernelbase|user32|gdi32|gdi32full|advapi32|shell32|ole32|oleaut32|ws2_32|ntdll|combase|bcrypt|bcryptprimitives|cryptbase|userenv|imm32|setupapi|version|winmm|shlwapi|rpcrt4|se...
return 1 if $name =~ $sys;
return 0;
}
if ( $^O eq 'darwin' ) {
return 1 if $name =~ m{\A/usr/lib/|/System/Library/|/Library/};
return 1 if $name =~ /\Alib(?:System|c\+\+|objc|resolv|iconv)\b/;
}
return 1 if $name =~ /\Alib(?:c|m|dl|pthread|rt|gcc_s|stdc\+\+|gomp|atomic|resolv|nsl|util|z|crypt|quadmath)\b/;
return 1 if $name =~ /\Ald-linux/;
return 0;
}
# Recover the library artifacts xrepo failed to list. A port that ships only static archives (a vcpkg zlib, say)
# can come back with an install tree but an empty `libfiles`, which used to drop the package into the header-only
# branch below and hand consumers an undef libpath for a package that plainly ships a library. Scans the linkdirs
# xrepo did report, then the conventional lib/lib64 under the install root, and returns ( libfiles, linkdirs ) so a
# directory that actually yielded something joins linkdirs and the -L flags agree with libfiles. Both come back
# untouched for a genuinely header-only package.
method _scan_libfiles ( $installdir, $linkdirs ) {
my $ext = $^O eq 'MSWin32' ? qr/\.(?:dll|lib)\z/i : qr/\.(?:dylib|a|so(?:\.[\d.]+)?)\z/i;
my @dirs = @$linkdirs;
push @dirs, map { path($installdir)->child($_)->stringify } qw[lib lib64] if defined $installdir && length $installdir;
my ( @libfiles, %found_in );
for my $dir (@dirs) {
next unless -d $dir;
my @found = map { $_->stringify } grep { $_->is_file && $_->basename =~ $ext } path($dir)->children;
next unless @found;
push @libfiles, @found;
$found_in{$dir} = 1;
}
return ( [], $linkdirs ) if !@libfiles;
my @all = @$linkdirs;
for my $dir (@dirs) {
push @all, $dir if $found_in{$dir} && !grep { $_ eq $dir } @all;
}
return ( \@libfiles, \@all );
}
method _process_info ($info) {
$info = $info->[0] if ref $info eq 'ARRAY';
return () unless ref $info eq 'HASH';
my $libfiles = $info->{libfiles} // [];
$libfiles = [$libfiles] unless ref $libfiles eq 'ARRAY';
my $incdirs = $info->{includedirs} // [];
$incdirs = [$incdirs] unless ref $incdirs eq 'ARRAY';
my $linkdirs = $info->{linkdirs} // [];
$linkdirs = [$linkdirs] unless ref $linkdirs eq 'ARRAY';
my $bindirs = $info->{bindirs} // [];
$bindirs = [$bindirs] unless ref $bindirs eq 'ARRAY';
my $links = $info->{links} // [];
( run in 0.744 second using v1.01-cache-2.11-cpan-1236ad508bc )