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


line stmt bran cond sub pod time code
1             package CPANPLUS::Dist::Debora;
2              
3             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
4              
5 2     2   76496 use 5.016;
  2         13  
6 2     2   11 use warnings;
  2         5  
  2         63  
7 2     2   12 use utf8;
  2         11  
  2         12  
8              
9             our $VERSION = '0.009';
10              
11 2     2   1006 use parent qw(CPANPLUS::Dist::Base);
  2         680  
  2         12  
12              
13 2     2   203173 use Config;
  2         6  
  2         88  
14 2     2   588 use English qw(-no_match_vars);
  2         3587  
  2         14  
15 2     2   773 use File::Spec;
  2         4  
  2         62  
16             use Module::Pluggable
17 2         15 search_path => 'CPANPLUS::Dist::Debora::Package',
18             sub_name => '_formats',
19 2     2   1072 require => 1;
  2         19016  
20              
21 2     2   1338 use CPANPLUS::Dist::Debora::Util qw(run);
  2         7  
  2         163  
22 2     2   15 use CPANPLUS::Error qw(error msg);
  2         6  
  2         2012  
23              
24             my @available_formats = do {
25             ##no critic (ClassHierarchies::ProhibitOneArgBless)
26             my @formats = bless({})->_formats;
27              
28             # Sort the formats by priority.
29             my %p = map { $_ => $_->format_priority } @formats;
30             grep { $p{$_} > 0 } reverse sort { $p{$a} <=> $p{$b} } @formats;
31             };
32              
33             sub format_available {
34 0     0 1   my $class = shift;
35              
36 0           return @available_formats > 0;
37             }
38              
39             sub init {
40 0     0 1   my $self = shift;
41              
42 0           my $status = $self->status;
43              
44 0           $status->mk_accessors(qw(_package));
45              
46 0           return 1;
47             }
48              
49             sub prepare {
50 0     0 1   my ($self, %params) = @_;
51              
52 0           my $status = $self->status;
53 0           my $module = $self->parent;
54 0           my $format = $available_formats[0];
55              
56             my $package = $format->new(
57             module => $module,
58             installdirs => $ENV{INSTALLDIRS} // 'vendor',
59 0   0       build_number => $ENV{BUILD} // 1,
      0        
60             );
61              
62 0           $status->_package($package);
63              
64 0           umask oct '022';
65              
66             # Run Makefile.PL or Build.PL.
67 0           my $ok = do {
68 0           my $dist_name = $package->dist_name;
69              
70             # We use PERL_MM_OPT since CPANPLUS::Dist:MM does not accept multiple
71             # options in makemakerflags. PERL_MB_OPT requires Module::Build 0.36.
72 0           local $ENV{PERL_MM_OPT} = $package->mm_opt;
73 0           local $ENV{PERL_MB_OPT} = $package->mb_opt;
74 0           local $ENV{MODULEBUILDRC} = 'NONE';
75 0           $params{buildflags} = q{};
76 0           $params{makemakerflags} = q{};
77              
78             # There are old distributions that expect "." to be in @INC.
79 0           local $ENV{PERL_USE_UNSAFE_INC} = 1;
80              
81             # Avoid an interactive prompt.
82 0 0         if ($dist_name eq 'Data-Dump-Streamer') {
83 0           $params{buildflags} = 'DDS';
84             }
85              
86             # We are not allowed to write to XML/SAX/ParserDetails.ini.
87 0           local $ENV{SKIP_SAX_INSTALL} = 1;
88              
89 0           $self->SUPER::prepare(%params);
90             };
91              
92 0           return $status->prepared($ok);
93             }
94              
95             sub create {
96 0     0 1   my ($self, %params) = @_;
97              
98 0           my $module = $self->parent;
99 0           my $backend = $module->parent;
100 0           my $config = $backend->configure_object;
101 0           my $status = $self->status;
102 0           my $package = $status->_package;
103 0           my $verbose = $params{verbose};
104              
105 0   0       my $make = $config->get_program('make') // 'make';
106 0           my $perl = $EXECUTABLE_NAME;
107              
108             # Build and test the Perl distribution.
109 0           my $ok = do {
110 0           my $dist_name = $package->dist_name;
111              
112             # Some tests fail if PERL_MM_OPT and PERL_MB_OPT are set.
113 0           delete local $ENV{PERL_MM_OPT};
114 0           delete local $ENV{PERL_MB_OPT};
115 0           local $ENV{MODULEBUILDRC} = 'NONE';
116 0           $params{buildflags} = q{};
117 0           $params{makemakerflags} = q{};
118              
119             # There are old distributions that expect "." to be in @INC.
120 0           local $ENV{PERL_USE_UNSAFE_INC} = 1;
121              
122             # Required by Term::ReadLine::Gnu if the history-size is set in
123             # ~/.inputrc.
124 0           local $ENV{INPUTRC} = File::Spec->devnull;
125              
126             # Dist::Zilla and Pinto require Perl 5.20.
127 0 0         if ($PERL_VERSION < 5.020) {
128 0           my $prereqs = $module->status->prereqs;
129 0 0         if (defined $prereqs) {
130 0 0         if ($dist_name =~ m{\A Task-Kensho}xms) {
131 0           delete $prereqs->{'Dist::Zilla'};
132 0           delete $prereqs->{'Pinto'};
133             }
134             }
135             }
136              
137 0           $self->SUPER::create(%params);
138             };
139              
140 0 0         if ($ok) {
141 0           $status->created(0);
142              
143             # Install the Perl distribution in a staging directory.
144 0           my $stagingdir = $package->stagingdir;
145              
146 0           my @install_cmd;
147 0           my $installer_type = $module->status->installer_type;
148 0 0         if ($installer_type eq 'CPANPLUS::Dist::MM') {
    0          
149 0           @install_cmd = ($make, 'install', "DESTDIR=$stagingdir");
150             }
151             elsif ($installer_type eq 'CPANPLUS::Dist::Build') {
152 0           @install_cmd = (
153             $perl, '-MCPANPLUS::Internals::Utils::Autoflush',
154             'Build', 'install',
155             '--destdir', $stagingdir,
156             split q{ }, $package->mb_opt,
157             );
158             }
159             else {
160 0           error("Unknown installer type $installer_type");
161 0           $ok = 0;
162             }
163              
164 0 0         if ($ok) {
165 0           $ok = run(
166             command => \@install_cmd,
167             dir => $package->builddir,
168             verbose => $verbose,
169             );
170 0 0         if ($ok) {
171 0           $ok = $package->sanitize_stagingdir;
172             }
173             }
174              
175             # Create a package.
176 0 0         if ($ok) {
177 0           my $outputname = $package->outputname;
178 0           msg("Creating '$outputname'");
179 0           $status->dist($outputname);
180 0           $ok = $package->create(verbose => $verbose);
181             }
182              
183 0 0         $package->remove_stagingdir or $ok = 0;
184             }
185              
186 0           return $status->created($ok);
187             }
188              
189             sub install {
190 0     0 1   my ($self, %params) = @_;
191              
192 0           my $status = $self->status;
193 0           my $package = $status->_package;
194 0           my $verbose = $params{verbose};
195              
196 0           my $ok = 0;
197              
198 0           my $outputname = $package->outputname;
199 0 0         if (-f $outputname) {
200 0           msg("Installing '$outputname'");
201 0           $ok = $package->install(verbose => $verbose);
202             }
203             else {
204 0           error("File not found '$outputname'");
205             }
206              
207 0           return $status->installed($ok);
208             }
209              
210             1;
211             __END__