view release on metacpan or  search on metacpan

lib/LedgerSMB/Installer.pm  view on Meta::CPAN

sub _post_boot_configure($class, $dss, $config) {
    Log::Any::Adapter->set('Stdout', log_level => $config->loglevel);
}

sub _boot($class, $args, $options) {
    my $dss = $class->_load_dist_support;
    my $config = LedgerSMB::Installer::Configuration->new(
        sys_pkgs => ($EFFECTIVE_USER_ID == 0)
        );

    GetOptionsFromArray(
        $args,
        $config->option_callbacks( $options ),
        );

    # normalize $installpath (at least cpanm needs that)
    # assume $locallib to be inside $installpath
    $config->normalize_paths;

    $class->_post_boot_configure( $dss, $config );
    return ($dss, $config);
}

my $signing_key_data = <<'KEY_DATA_END';
-----BEGIN PGP PUBLIC KEY BLOCK-----
Comment: Hostname: fr.pgpkeys.eu
Version: Hockeypuck 2.2.4

xsBNBEYTN1ABCACuVLUCasiD4KnetfEHtMo+qDjKbcWauIkw/KU+gj8kN7Y+E3ye
cLxtY1gJlZp0iIgnZ6aw7bPCleTXbBfXXbMyLs0+CN9cfCyXB5TU4nlh16or/vlE
C+0WjEuD9Qznm805RXJGvIRPobXrxcO7aB7pT3NkKj2z//9D0w0uC+BDEl0uihZG
+fIbb2ihPWO/r9ghHhyMRTibSRye09owhVpr/5gYRFtvp7OsYHaLhUD3+WXPhGIZ
U7YqBFRumDNR+S8EewuKj0CBxCtC+iSFyR/fNPh50FbtgqY/9qLmZa/u42oyjrCl
TM+ALCM+PutEPVEIyVoO4jluoZ8yG4IFVxyxABEBAAHNZUxlZGdlclNNQiBDb3Jl
IFRlYW0gKFRoaXMgaXMgdGhlIGtleSB1c2VkIGZvciBwYWNrYWdlIHNpZ25pbmcu
KSA8bGVkZ2VyLXNtYi1jb3JlQGxpc3RzLmxlZGdlcnNtYi5vcmc+wsB2BBMBAgAg
BQJGEzdQAhsDBgsJCAcDAgQVAggDBBYCAwECHgECF4AACgkQOaYpVY2grxAaDwgA
kp2LZNyrZDom1tBwR3aisfYFkkiuFrUZUn+fYwr7wnkq06gpYGZrNgdcanSxjGoD
wf2kMeCwWAD6sao824onboJWRi1LR3Q5RKIAvYBeLZ75/hYSy3JP/YLMl047IWcU
CMaqZfmXPHvkOdUblPxCaKJM8c9Sb6KxGzu4BU2Y97TvQjn9xNbq4t7Pgpu5RORH
Hp96V+kZXGxzQo0gCE+6dr1JFZeTKmTkGSvkchndn5UVLguLIg9kCxxcDiS7hmTx
yB+b0+kPgRUb0YVp6QqFq7O8fvzhsW8sYopBJsbArODS2qeMiwPUnKs+7qkZg8Jd
j2QoHZCY06NU6yvqq/CIt8JGBBARAgAGBQJIx9P/AAoJEHc352JrCredRJwAnRFe
UDqpUCw368z/Ht6FDInXnC2kAJ995NXymKbQVg478EdOrJT8h1SPRA==
=a/2y
-----END PGP PUBLIC KEY BLOCK-----
KEY_DATA_END

sub _build_install_tree($class, $dss, $config, $installpath, $version) {
    my $archive = "ledgersmb-$version.tar.gz";

    if (not -d $installpath ) {
        $log->info( "Creating installation path $installpath" );
        make_path( $installpath ); # croaks on fatal errors
    }

    $log->info( "Downloading release tarball $archive" );
    $class->_download( $installpath, $version );

    $log->info( "Verifying tarball against gpg public key & signature" );
    my $downloaded_tar = File::Spec->catfile( $installpath, $archive );
    $dss->verify_sig( $installpath,
                      $downloaded_tar,
                      "$downloaded_tar.asc",
                      $signing_key_data )
        if $config->verify_sig;

    $log->info( "Extracting release tarball" );
    $dss->untar( $downloaded_tar,
                 $installpath,
                 no_same_owner => 1,
                 strip_components => 1 );
    $config->cpanfile_path( File::Spec->catfile( $installpath, 'cpanfile' ) );

    $log->info( "Removing extracted release tarball" );
    # croaks on fatal errors:
    remove_tree( $downloaded_tar, "$downloaded_tar.asc" );
}

sub _get_cpanfile($class, $config) {
    return $config->cpanfile if $config->cpanfile;

    my $cpanfile;
    if ($config->cpanfile_path) {
        $cpanfile = $config->cpanfile_path;
    }
    else {
        my $url =
            sprintf("https://raw.githubusercontent.com/ledgersmb/LedgerSMB/refs/tags/%s/cpanfile",
                    $config->effective_version);

        my $response = $http->get( $url );
        unless ($response->{success}) {
            die $log->fatal("Unable to get '$url' from GitHub: $response->{content}");
        }

        my ($fh, $fn) = tempfile();
        print $fh $response->{content};
        $fh->flush;
        $cpanfile = $fn;
    }

    my $decl = Module::CPANfile->load( $cpanfile );
    $config->cpanfile( $decl );

    return $decl;
}

sub _get_immediate_prereqs($class, $config) {
    my $decl = $class->_get_cpanfile( $config );
    return $decl->prereqs;
}

sub _compute_immediate_deps($class, $config) {
    my @types     = qw( requires recommends );
    my @phases    = qw( runtime );
    my $decl      = $class->_get_cpanfile( $config );
    my $prereqs   = $decl->prereqs_with( map { $_->identifier } $decl->features ); # all features
    my $effective = CPAN::Meta::Requirements->new;
    for my $phase (@phases) {