view release on metacpan or  search on metacpan

lib/Alien/Xrepo.pm  view on Meta::CPAN

        # 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, $full_spec );
        $self->_debug_cmd(@install_cmd);
        $self->blah("Running: @install_cmd");
        system(@install_cmd) == 0 or die "xrepo install failed for $full_spec";
        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} // '' );
        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';
        return -f $e->{libpath} if defined $e->{libpath} && length $e->{libpath};
        defined $e->{installdir} && length $e->{installdir} && -d $e->{installdir};
    }

    method _cache_get ( $key, $meta ) {
        my $e = $meta->{entries}{$key} or return ();
        return () unless $self->_entry_alive($e);
        $e->{last_used} = time;
        $meta->{order}  = [ $key, grep { $_ ne $key } @{ $meta->{order} } ];
        $e;
    }

    method _cache_put ( $key, $meta, $entry, $max //= _CACHE_MAX() ) {
        $meta->{entries}{$key} = $entry;
        $meta->{order} = [ $key, grep { $_ ne $key } @{ $meta->{order} } ];
        while ( @{ $meta->{order} } > $max ) {
            delete $meta->{entries}{ pop @{ $meta->{order} } };
        }
        $meta;
    }

    method _cache_entry ($data) {
        my $info  = ref $data eq 'ARRAY' ? $data->[0] : $data;
        my %entry = ( json => encode_json($data), last_used => time );
        if ( ref $info eq 'HASH' ) {
            my $art = $info->{artifacts};
            if    ( ref $art eq 'HASH' && defined $art->{installdir} ) { $entry{installdir} = $art->{installdir}; }
            elsif ( defined $info->{installdir} )                      { $entry{installdir} = $info->{installdir}; }
            if    ( @{ $info->{libfiles} // [] } )                     { $entry{libpath}    = $info->{libfiles}[0]; }
        }
        \%entry;
    }

    method _try_fetch ( $full_spec, $opts ) {
        my @fetch_args = $self->_build_args($opts);
        my @fetch_cmd  = $self->_argv( 'fetch', [ '--json', @fetch_args ], $full_spec );
        $self->_debug_cmd(@fetch_cmd);
        $self->blah("Running: @fetch_cmd");
        my ( $out, $err, $exit ) = capture { system @fetch_cmd };
        return ( undef, "Command: @fetch_cmd\nError:\n$err" ) if $exit != 0;
        return ( undef, "Command: @fetch_cmd\nNo JSON output" ) unless defined $out && length $out;
        my $data = eval { $self->_decode_json_output($out) };
        return ( undef, "Command: @fetch_cmd\n$@" ) if !defined $data;
        ( $data, undef );
    }

    # Mandatory fetch: after an install we have to know where the output landed, so a failure here is fatal. $why
    # carries the earlier probe error so the die explains which attempt failed.
    method _require_fetch ( $full_spec, $opts, $why //= () ) {
        my ( $data, $err ) = $self->_try_fetch( $full_spec, $opts );
        unless ( defined $data ) {
            die "xrepo fetch failed:\n$err\n" . ( defined $why && length $why ? "\n(an earlier fetch probe also failed:\n$why)" : () );
        }
        $data;