File Coverage

blib/lib/CPANPLUS/Dist/Debora.pm

Criterion	Covered	Total	%
statement	29	112	25.8
branch	0	24	0.0
condition	0	6	0.0
subroutine	10	15	66.6
pod	5	5	100.0
total	44	162	27.1

package CPANPLUS::Dist::Debora;

# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later

use 5.016;
use warnings;
use utf8;

our $VERSION = '0.010';

use parent qw(CPANPLUS::Dist::Base);

use Config;
use English qw(-no_match_vars);
use File::Spec;
use Module::Pluggable
    search_path => 'CPANPLUS::Dist::Debora::Package',
    sub_name    => '_formats',
    require     => 1;

use CPANPLUS::Dist::Debora::Util qw(run);
use CPANPLUS::Error qw(error msg);

my @available_formats = do {
    ##no critic (ClassHierarchies::ProhibitOneArgBless)
    my @formats = bless({})->_formats;

    # Sort the formats by priority.
    my %p = map { $_ => $_->format_priority } @formats;
    grep { $p{$_} > 0 } reverse sort { $p{$a} <=> $p{$b} } @formats;
};

sub format_available {
    my $class = shift;

    return @available_formats > 0;
}

sub init {
    my $self = shift;

    my $status = $self->status;

    $status->mk_accessors(qw(_package));

    return 1;
}

sub prepare {
    my ($self, %params) = @_;

    my $status = $self->status;
    my $module = $self->parent;
    my $format = $available_formats[0];

    my $package = $format->new(
        module       => $module,
        installdirs  => $ENV{INSTALLDIRS} // 'vendor',
        build_number => $ENV{BUILD}       // 1,
    );

    $status->_package($package);

    umask oct '022';

    # Run Makefile.PL or Build.PL.
    my $ok = do {
        my $dist_name = $package->dist_name;

        # We use PERL_MM_OPT since CPANPLUS::Dist:MM does not accept multiple
        # options in makemakerflags.  PERL_MB_OPT requires Module::Build 0.36.
        local $ENV{PERL_MM_OPT}   = $package->mm_opt;
        local $ENV{PERL_MB_OPT}   = $package->mb_opt;
        local $ENV{MODULEBUILDRC} = 'NONE';
        $params{buildflags}     = q{};
        $params{makemakerflags} = q{};

        # There are old distributions that expect "." to be in @INC.
        local $ENV{PERL_USE_UNSAFE_INC} = 1;

        # Avoid an interactive prompt.
        if ($dist_name eq 'Data-Dump-Streamer') {
            $params{buildflags} = 'DDS';
        }

        # We are not allowed to write to XML/SAX/ParserDetails.ini.
        local $ENV{SKIP_SAX_INSTALL} = 1;

        $self->SUPER::prepare(%params);
    };

    return $status->prepared($ok);
}

sub create {
    my ($self, %params) = @_;

    my $module  = $self->parent;
    my $backend = $module->parent;
    my $config  = $backend->configure_object;
    my $status  = $self->status;
    my $package = $status->_package;
    my $verbose = $params{verbose};

    my $make = $config->get_program('make') // 'make';
    my $perl = $EXECUTABLE_NAME;

    # Build and test the Perl distribution.
    my $ok = do {
        my $dist_name = $package->dist_name;

        # Some tests fail if PERL_MM_OPT and PERL_MB_OPT are set.
        delete local $ENV{PERL_MM_OPT};
        delete local $ENV{PERL_MB_OPT};
        local $ENV{MODULEBUILDRC} = 'NONE';
        $params{buildflags}     = q{};
        $params{makemakerflags} = q{};

        # There are old distributions that expect "." to be in @INC.
        local $ENV{PERL_USE_UNSAFE_INC} = 1;

        # Required by Term::ReadLine::Gnu if the history-size is set in
        # ~/.inputrc.
        local $ENV{INPUTRC} = File::Spec->devnull;

        # Dist::Zilla and Pinto require Perl 5.20.
        if ($PERL_VERSION < 5.020) {
            my $prereqs = $module->status->prereqs;
            if (defined $prereqs) {
                if ($dist_name =~ m{\A Task-Kensho}xms) {
                    delete $prereqs->{'Dist::Zilla'};
                    delete $prereqs->{'Pinto'};
                }
            }
        }

        $self->SUPER::create(%params);
    };

    if ($ok) {
        $status->created(0);

        # Install the Perl distribution in a staging directory.
        my $stagingdir = $package->stagingdir;

        my @install_cmd;
        my $installer_type = $module->status->installer_type;
        if ($installer_type eq 'CPANPLUS::Dist::MM') {
            @install_cmd = ($make, 'install', "DESTDIR=$stagingdir");
        }
        elsif ($installer_type eq 'CPANPLUS::Dist::Build') {
            @install_cmd = (
                $perl,       '-MCPANPLUS::Internals::Utils::Autoflush',
                'Build',     'install',
                '--destdir', $stagingdir,
                split q{ },  $package->mb_opt,
            );
        }
        else {
            error("Unknown installer type $installer_type");
            $ok = 0;
        }

        if ($ok) {
            $ok = run(
                command => \@install_cmd,
                dir     => $package->builddir,
                verbose => $verbose,
            );
            if ($ok) {
                $ok = $package->sanitize_stagingdir;
            }
        }

        # Create a package.
        if ($ok) {
            my $outputname = $package->outputname;
            msg("Creating '$outputname'");
            $status->dist($outputname);
            $ok = $package->create(verbose => $verbose);
        }

        $package->remove_stagingdir or $ok = 0;
    }

    return $status->created($ok);
}

sub install {
    my ($self, %params) = @_;

    my $status  = $self->status;
    my $package = $status->_package;
    my $verbose = $params{verbose};

    my $ok = 0;

    my $outputname = $package->outputname;
    if (-f $outputname) {
        msg("Installing '$outputname'");
        $ok = $package->install(verbose => $verbose);
    }
    else {
        error("File not found '$outputname'");
    }

    return $status->installed($ok);
}

1;
__END__