Alien-Xrepo
view release on metacpan or search on metacpan
lib/Alien/Xrepo.pm view on Meta::CPAN
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';
return -f $e->{libpath} if defined $e->{libpath} && length $e->{libpath};
defined $e->{installdir} && length $e->{installdir} && -d $e->{installdir};
}
lib/Alien/Xrepo/Build.pm view on Meta::CPAN
if ($snapshot) {
my $data = {
dist_name => $recipe->name,
install_type => $install_type,
pkg_roots => $recipe->pkg_roots,
packages => $runtime_prop->{packages} // {},
errors => $runtime_prop->{errors} // {},
digest => $self->_config_digest
};
path($snapshot)->parent->mkpath if defined $snapshot;
path($snapshot)->spew_utf8( encode_json($data) . "\n" );
say "Wrote runtime snapshot $snapshot" if $verbose;
}
$self->_checkpoint;
$stage_done->{export} = 1;
$self;
}
method test () {
return if $stage_done->{test};
$self->run_hooks('test');
lib/Alien/Xrepo/Build.pm view on Meta::CPAN
method _checkpoint () {
return unless defined $checkpoint;
path($checkpoint)->parent->mkpath;
my $data = {
install_type => $install_type,
stage_done => $stage_done,
meta_prop => $meta_prop,
install_prop => $install_prop,
runtime_prop => $runtime_prop
};
path($checkpoint)->spew_utf8( encode_json($data) . "\n" );
return;
}
#
method _load_checkpoint () {
return 0 unless defined $checkpoint && -e $checkpoint;
my $data = eval { decode_json( path($checkpoint)->slurp_utf8 ) };
return 0 unless ref $data eq 'HASH';
$install_type = $data->{install_type} // 'system';
$stage_done = $data->{stage_done} // {};
$meta_prop = $data->{meta_prop} // {};
$install_prop = $data->{install_prop} // {};
$runtime_prop = $data->{runtime_prop} // {};
return 1;
}
};
#
lib/Alien/Xrepo/Build/Recipe.pm view on Meta::CPAN
field @order : reader(packages); # package names in recipe order (first = primary)
field %defs; # package name => normalized per-package hashref def
method package_defs { \%defs }
#
ADJUST {
if ( defined $file || defined $dir ) {
die 'Recipe: pass exactly one of file / dir / inline data' if defined $file && defined $dir;
die q[Recipe: inline 'packages' is ignored when a file is given] if defined $packages;
my $path = $file // path($dir)->child('xrepo.json');
die 'Recipe file not found: ' . $path unless -e $path;
my $data = eval { decode_json( path($path)->slurp_utf8 ) };
die "Recipe '$path' is not valid JSON: $@" if !defined $data || ref $data ne 'HASH';
$name //= $data->{name};
$packages //= $data->{packages};
$defaults //= $data->{defaults};
$pkg_roots //= $data->{pkg_roots};
$local_repos //= $data->{local_repos} // [];
$hooks //= $data->{hooks} // [];
}
die 'Recipe: packages is required' unless defined $packages;
@order = ( $self->_normalize_defs($packages) );
lib/Alien/Xrepo/Runtime.pm view on Meta::CPAN
#
# Hermetic mode: a snapshot file wins entirely (no xrepo subprocess).
method _load_snapshot () {
my $file = $snapshot;
if ( !defined $file && $autodetect_snapshot ) {
for my $cand ( __PACKAGE__->_snapshot_candidates_for( ref $self ) ) {
if ( -e $cand ) { $file = $cand; last; }
}
}
return unless defined $file && -e $file;
my $data = eval { decode_json( path($file)->slurp_utf8 ) };
return unless ref $data eq 'HASH';
$snap = $data->{packages} // {};
$snap_install_type = $data->{install_type};
for my $name ( keys %$snap ) {
$infos->{$name} = Alien::Xrepo::PackageInfo->new( %{ $snap->{$name} } );
}
return;
}
# Where autodetect looks for a subclass: the installed dist's share dir then the source-tree build artifact layout.
t/050_recipe.t view on Meta::CPAN
my %zstd = $recipe->opts_for( 'zstd', kind => 'static', configs => { wayland => 0 } );
is $zstd{kind}, 'static', 'plain entry keeps ambient kind';
is $zstd{configs}{wayland}, 0, 'plain entry keeps ambient configs';
my %sdl = $recipe->opts_for( 'libsdl3', kind => 'static', configs => { zlib => 0, wayland => 0 } );
is $sdl{kind}, 'shared', 'def kind overrides ambient';
is $sdl{configs}{zlib}, 0, 'ambient configs preserved';
is $sdl{configs}{wayland}, 1, 'def config wins per-key';
};
subtest 'file round-trip (xrepo.json)' => sub {
my $file = path($dir)->child('xrepo.json');
$file->spew_utf8(
encode_json(
{ name => 'Alien-Zstandard',
packages => [ { name => 'zstd', version => '1.5.6', kind => 'shared' } ],
defaults => { mode => 'release', configs => { legacy => 1 } },
pkg_roots => { ZSTD => '$ZSTD' },
local_repos => ['vendor/recipes'],
hooks => ['Alien::Zstandard::Hooks']
}
)
);
t/051_engine.t view on Meta::CPAN
$b2->gather;
my (@f2) = grep { $_->{action} eq 'fetch' } @{ $spy2->calls };
is scalar @f2, 1, 'gather fetches when install never ran';
};
subtest 'export writes the runtime snapshot' => sub {
my $snap = path($dir)->child('snapshot.json');
my $spy = Alien::Xrepo::Build::TestSpy->new;
my $b = build( [ { name => 'zstd', version => '1.5.6' } ], repo => $spy, probe_policy => 'off', snapshot => $snap );
$b->run;
ok -e $snap, 'snapshot file written';
my $data = decode_json( $snap->slurp_utf8 );
is $data->{install_type}, 'share', 'snapshot records install_type';
is $data->{packages}{zstd}{version}, '1.5.6', 'snapshot records runtime data';
is $data->{packages}{zstd}{installdir}, '/tmp/store/zstd', 'snapshot records installdir';
};
subtest 'checkpoint/resume skips completed work' => sub {
my $cp = path($dir)->child('state.json');
my $spy = Alien::Xrepo::Build::TestSpy->new;
my $b = build( ['zstd'], repo => $spy, probe_policy => 'off', checkpoint => $cp );
$b->run;
my $calls_after_first = scalar @{ $spy->calls };
t/051_engine.t view on Meta::CPAN
ok !$b->has_hook('probe'), 'unregistered stage has no hooks';
like dies {
$b->register_hook( bogus => sub { } )
}, qr/Unknown stage/, 'bad stage dies';
$b->run;
is \@ran, [qw[install gather]], 'hooks fired in stage order';
};
our @HOOK_RAN;
subtest 'recipe hooks load once and register stage callbacks' => sub {
my $hdir = Path::Tiny->tempdir;
$hdir->child('RecipeHooksDemo.pm')->spew_utf8(
q{
package RecipeHooksDemo;
sub register_hooks {
my ($build) = @_;
push @main::HOOK_RAN, 'register';
$build->register_hook( install => sub { push @main::HOOK_RAN, 'install' } );
}
1;
}
);
t/051_engine.t view on Meta::CPAN
is \@main::HOOK_RAN, ['register'], 'recipe hook module saw register_hooks';
is $b->has_hook('install'), 1, 'recipe hook attached a stage hook';
@main::HOOK_RAN = ();
$b->configure;
is scalar @main::HOOK_RAN, 0, 'recipe hooks load once even if configure repeats';
$b->install;
is \@main::HOOK_RAN, ['install'], 'recipe-registered hook fired at its stage';
};
subtest 'recipe hooks die clearly when the module lacks register_hooks' => sub {
my $hdir = Path::Tiny->tempdir;
$hdir->child('RecipeHooksBad.pm')->spew_utf8("package RecipeHooksBad;\n1;\n");
local @INC = ( @INC, $hdir->stringify );
my $spy = Alien::Xrepo::Build::TestSpy->new;
my $b = build( ['zstd'], repo => $spy, recipe_extra => { hooks => ['RecipeHooksBad'] } );
like dies { $b->configure }, qr/register_hooks/, 'missing register_hooks dies at configure';
};
subtest 'pkg_roots resolve a package from a system root' => sub {
my $root = Path::Tiny->tempdir;
$root->child('include')->mkpath;
$root->child('lib')->mkpath;
$root->child( 'include', 'zstd.h' )->spew_utf8('#define ZSTD 1');
$root->child( 'lib', 'libzstd.a' )->spew_utf8('');
local $ENV{ZSTD_ROOT} = $root->stringify;
my $spy = Alien::Xrepo::Build::TestSpy->new;
my $b = build( ['zstd'], repo => $spy, recipe_extra => { pkg_roots => { zstd => 'ZSTD_ROOT' } } );
$b->run;
my (@infos) = grep { $_->{action} eq 'info' } @{ $spy->calls };
my (@installs) = grep { $_->{action} eq 'install' } @{ $spy->calls };
my (@fetches) = grep { $_->{action} eq 'fetch' } @{ $spy->calls };
is scalar @infos, 0, 'probe never consults xrepo for a root-resolved package';
is scalar @installs, 0, 'install never consults xrepo for a root-resolved package';
is scalar @fetches, 0, 'gather never consults xrepo for a root-resolved package';
t/052_runtime.t view on Meta::CPAN
my $spy = Alien::Xrepo::Runtime::TestSpy->new;
my $a = Alien::Xrepo::Runtime->new( pkg_name => [ 'zstd', 'libsdl3' ], repo => $spy );
my $alt = $a->alt('libsdl3');
like $alt->cflags, qr/libsdl3/, 'alt accessors pinned to libsdl3';
like $a->cflags, qr/zstd/, 'primary accessors stay on zstd';
ok $a->alt eq $a, 'alt of the primary returns self';
like dies { $a->alt('nope') }, qr/Unknown package/, 'alt of an unknown package dies';
};
subtest 'hermetic snapshot: no xrepo call at all' => sub {
my $snap = path($dir)->child('snapshot.json');
$snap->spew_utf8(
encode_json(
{ dist_name => 'Alien-Zstandard',
install_type => 'share',
packages => {
zstd => {
includedirs => ['C:/snap/zstd/include'],
libfiles => ['C:/snap/zstd/bin/zstd.dll'],
license => undef,
linkdirs => ['C:/snap/zstd/lib'],
links => ['zstd'],
t/053_install_cache.t view on Meta::CPAN
subtest 'cache save replaces existing/read-only cache and clears a stale tmp' => sub {
my $store = Path::Tiny->tempdir;
my $live = $store->child( 'pkgs', 'z', 'bin' );
$live->mkpath;
my $meta = { order => [], entries => {} };
$repo->_cache_put( 'z', $meta, { installdir => "$live", last_used => time }, 10 );
$repo->_cache_save( $meta, installdir => "$store" );
my $cache = $store->child( '.alien-xmake', 'cache.json' );
ok $cache->exists, 'first save writes cache.json';
my $stale = $store->child( '.alien-xmake', 'cache.json.tmp' );
$stale->spew_utf8('{"stale":true}');
$cache->spew_utf8('{"old":true}'); # existing dest a Windows rename would refuse
$repo->_cache_save( $meta, installdir => "$store" );
ok !$stale->exists, 'stale tmp cleared before save';
my $loaded = $repo->_cache_load( installdir => "$store" );
is [ @{ $loaded->{order} } ], ['z'], 'existing cache.json replaced on save';
if ( $^O eq 'MSWin32' ) {
$cache->chmod(0444);
ok !-w $cache, 'dest is read-only for the edge case';
$repo->_cache_save( $meta, installdir => "$store" );
ok $cache->exists, 'read-only dest replaced without dying';
( run in 0.791 second using v1.01-cache-2.11-cpan-364913b4093 )