File Coverage

blib/lib/CPAN/Plugin/Sysdeps.pm
Criterion Covered Total %
statement 248 403 61.5
branch 151 286 52.8
condition 40 66 60.6
subroutine 30 36 83.3
pod 2 2 100.0
total 471 793 59.3


line stmt bran cond sub pod time code
1             package CPAN::Plugin::Sysdeps;
2              
3 7     7   479786 use strict;
  7         67  
  7         262  
4 7     7   43 use warnings;
  7         15  
  7         333  
5              
6             our $VERSION = '0.70';
7              
8 7     7   49 use List::Util 'first';
  7         14  
  7         962  
9              
10             our $TRAVERSE_ONLY; # only for testing
11              
12 7     7   58 use constant SUPPORTED_NUMERICAL_OPS => ['<','<=','==','>','>='];
  7         14  
  7         1056  
13 7         68 use constant SUPPORTED_NUMERICAL_OPS_RX => do {
14 7         27 my $rx = '^(' . join('|', map { quotemeta } @{SUPPORTED_NUMERICAL_OPS()}) . ')$';
  31         85  
  7         42  
15 7         15578 qr{$rx};
16 7     7   58 };
  7         14  
17              
18             sub new {
19 29     29 1 197888 my($class, @args) = @_;
20              
21 29         155 my $installer;
22 29         55 my $batch = 0;
23 29         50 my $dryrun = 0;
24 29         74 my $debug = 0;
25 29         95 my @additional_mappings;
26             my @args_errors;
27 29         2 my $options;
28 29         111 for my $arg (@args) {
29 81 100       588 if (ref $arg eq 'HASH') {
    100          
    100          
    100          
    100          
    50          
    0          
30 15 50       44 if ($options) {
31 1         112 die "Cannot handle multiple option hashes";
32             } else {
33 15         45 $options = $arg;
34             }
35             } elsif ($arg =~ m{^(apt-get|aptitude|pkg|pkg_add|yum|dnf|chocolatey|homebrew)$}) { # XXX are there more package installers?
36 12         44 $installer = $1;
37             } elsif ($arg eq 'batch') {
38 20         100 $batch = 1;
39             } elsif ($arg eq 'interactive') {
40 2         12 $batch = 0;
41             } elsif ($arg eq 'dryrun') {
42 20         41 $dryrun = 1;
43             } elsif ($arg =~ m{^mapping=(.*)$}) {
44 17         101 push @additional_mappings, $1;
45             } elsif ($arg =~ m{^debug(?:=(\d+))?$}) {
46 1 0       14 $debug = defined $1 ? $1 : 1;
47             } else {
48 1         3 push @args_errors, $arg;
49             }
50             }
51 29 50       169 if (@args_errors) {
52 1 0       8 die 'Unrecognized ' . __PACKAGE__ . ' argument' . (@args_errors != 1 ? 's' : '') . ": @args_errors\n";
53             }
54              
55 29 50       108 if (exists $ENV{CPAN_PLUGIN_SYSDEPS_DEBUG}) {
56 1         37 $debug = $ENV{CPAN_PLUGIN_SYSDEPS_DEBUG};
57             }
58 29 50       103 if ($debug) {
59 1         3 require Data::Dumper; # we'll need it
60             }
61              
62 29   66     212 my $os = $options->{os} || $^O;
63 29         63 my $osvers = '';
64 29         47 my $linuxdistro = '';
65 29         107 my $linuxdistroversion = 0;
66 29         51 my $linuxdistrocodename = '';
67 29 100 33     96 if ($os eq 'linux') {
    50 33        
68 20         65 my $linux_info;
69             my $get_linux_info = sub {
70 43 100   43   154 return $linux_info if $linux_info;
71 15         78 return $linux_info = _detect_linux_distribution();
72 20         101 };
73 19 100       65 if (defined $options->{linuxdistro}) {
74 5         10 $linuxdistro = $options->{linuxdistro};
75             } else {
76 14         34 $linuxdistro = lc $get_linux_info->()->{linuxdistro};
77             }
78              
79 19 100       75 if (defined $options->{linuxdistroversion}) {
80 5         11 $linuxdistroversion = $options->{linuxdistroversion};
81             } else {
82 14         35 $linuxdistroversion = $get_linux_info->()->{linuxdistroversion}; # XXX make it a version object? or make sure it's just X.Y?
83             }
84              
85 19 100       46 if (defined $options->{linuxdistrocodename}) {
86 5         86 $linuxdistrocodename = $options->{linuxdistrocodename};
87             } else {
88 14         37 $linuxdistrocodename = $get_linux_info->()->{linuxdistrocodename};
89             }
90             } elsif (($os eq 'freebsd') || ($os eq 'openbsd') || ($os eq 'dragonfly')) {
91             # Note: don't use $Config{osvers}, as this is just the OS
92             # version of the system which built the current perl, not the
93             # actually running OS version.
94 9 50       22 if (defined $options->{osvers}) {
95 9         14 $osvers = $options->{osvers};
96             } else {
97 0         0 chomp($osvers = `/sbin/sysctl -n kern.osrelease`);
98             }
99             }
100              
101 28 100       125 if (!$installer) {
102 17 100 66     98 if ($os eq 'freebsd' || $os eq 'dragonfly') {
    50          
    50          
    50          
    0          
    0          
103 9         14 $installer = 'pkg';
104             } elsif ($os eq 'gnukfreebsd') {
105 0         0 $installer = 'apt-get';
106             } elsif ($os eq 'openbsd') {
107 0         0 $installer = 'pkg_add';
108             } elsif ($os eq 'linux') {
109 8 50       36 if (__PACKAGE__->_is_linux_debian_like($linuxdistro)) {
    0          
110 8         19 $installer = 'apt-get';
111             } elsif (__PACKAGE__->_is_linux_fedora_like($linuxdistro)) {
112 0 0       0 if (_detect_dnf()) {
113 0         0 $installer = 'dnf';
114             } else {
115 0         0 $installer = 'yum';
116             }
117             } else {
118 0         0 die __PACKAGE__ . " has no support for linux distribution $linuxdistro $linuxdistroversion\n";
119             }
120             } elsif( $os eq 'MSWin32' ) {
121 0         0 $installer = 'chocolatey';
122             } elsif ($os eq 'darwin') {
123 0         0 $installer = 'homebrew';
124             } else {
125 0         0 die __PACKAGE__ . " has no support for operating system $os\n";
126             }
127             }
128              
129 28         54 my @mapping;
130 28         464 for my $mapping (@additional_mappings, 'CPAN::Plugin::Sysdeps::Mapping') {
131 44 100       729 if (-r $mapping) {
132 16 50       691 open my $fh, '<', $mapping
133             or die "Can't load $mapping: $!";
134 16         103 local $/;
135 16         560 my $buf = <$fh>;
136 16         2985 push @mapping, eval $buf;
137 16 50       342 die "Error while loading $mapping: $@" if $@;
138             } else {
139 28 50       1899 eval "require $mapping"; die "Can't load $mapping: $@" if $@;
  28         146  
140 28         160 push @mapping, $mapping->mapping;
141             }
142             }
143              
144 28         373 my %config =
145             (
146             installer => $installer,
147             batch => $batch,
148             dryrun => $dryrun,
149             debug => $debug,
150             os => $os,
151             osvers => $osvers,
152             linuxdistro => $linuxdistro,
153             linuxdistroversion => $linuxdistroversion,
154             linuxdistrocodename => $linuxdistrocodename,
155             mapping => \@mapping,
156             );
157 28         153 my $self = bless \%config, $class;
158 28 50       73 if (eval { require Hash::Util; 1 }) {
  28         7368  
  28         22973  
159 28         98 Hash::Util::lock_keys($self);
160             }
161 28         602 $self;
162             }
163              
164             # CPAN.pm plugin hook method
165             sub post_get {
166 4     5 1 1469 my($self, $dist) = @_;
167              
168 4         24 my @packages = $self->_map_cpandist($dist);
169 3 100       18 if (@packages) {
170 2         11 my @uninstalled_packages = $self->_filter_uninstalled_packages(@packages);
171 2 50       37 if (@uninstalled_packages) {
172 2         39 my @cmds = $self->_install_packages_commands(@uninstalled_packages);
173 2         15 for my $cmd (@cmds) {
174 2 50       14 if ($self->{dryrun}) {
175 2         433 warn "DRYRUN: @$cmd\n";
176             } else {
177 0         0 warn "INFO: run @$cmd...\n";
178              
179 0         0 system @$cmd;
180 0 0       0 if ($? != 0) {
181 0         0 die "@$cmd failed, stop installation";
182             }
183             }
184             }
185             }
186             }
187             }
188              
189             # Helpers/Internal functions/methods
190             sub _detect_linux_distribution {
191 14 50   15   278 if (-x '/usr/bin/lsb_release') {
192 0         0 _detect_linux_distribution_lsb_release();
193             } else {
194 14         57 _detect_linux_distribution_fallback();
195             }
196             }
197              
198             sub _detect_linux_distribution_lsb_release {
199 0     1   0 my %info;
200 0         0 my @cmd = ('lsb_release', '-irc');
201 0 0       0 open my $fh, '-|', @cmd
202             or die "Error while running '@cmd': $!";
203 0         0 while(<$fh>) {
204 0         0 chomp;
205 0 0       0 if (m{^Distributor ID:\s+(.*)}) {
    0          
    0          
206 0         0 $info{linuxdistro} = $1;
207             } elsif (m{^Release:\s+(.*)}) {
208 0         0 $info{linuxdistroversion} = $1;
209             } elsif (m{^Codename:\s+(.*)}) {
210 0         0 $info{linuxdistrocodename} = $1;
211             } else {
212 0         0 warn "WARNING: unexpected '@cmd' output '$_'";
213             }
214             }
215 0 0       0 close $fh
216             or die "Error while running '@cmd': $!";
217 0         0 \%info;
218             }
219              
220             sub _detect_linux_distribution_fallback {
221 14 50   15   926 if (open my $fh, '<', '/etc/redhat-release') {
222 0         0 my $contents = <$fh>;
223 0 0       0 if ($contents =~ m{^(CentOS|RedHat|Fedora) (?:Linux )?release (\d+)\S*( \((.*?)\))?}) {
224 0 0       0 return {linuxdistro => $1, linuxdistroversion => $2, linuxdistrocodename => defined $3 ? $3 : ''};
225             }
226             }
227 14 50       589 if (open my $fh, '<', '/etc/issue') {
228 14         1489 chomp(my $line = <$fh>);
229 14 50       170 if ($line =~ m{^Linux Mint (\d+) (\S+)}) {
    50          
    50          
230 0         0 return {linuxdistro => 'LinuxMint', linuxdistroversion => $1, linuxdistrocodename => $2};
231             } elsif ($line =~ m{^(Debian) GNU/Linux (\d+)}) {
232 0         0 my %info = (linuxdistro => $1, linuxdistroversion => $2);
233             $info{linuxdistrocodename} =
234             {
235             6 => 'squeeze',
236             7 => 'wheezy',
237             8 => 'jessie',
238             9 => 'stretch',
239             10 => 'buster',
240             11 => 'bullseye',
241 0         0 }->{$info{linuxdistroversion}};
242 0         0 return \%info;
243             } elsif ($line =~ m{^(Ubuntu) (\d+\.\d+)}) {
244 14         110 my %info = (linuxdistro => $1, linuxdistroversion => $2);
245             $info{linuxdistrocodename} =
246             {
247             '12.04' => 'precise',
248             '14.04' => 'trusty',
249             '16.04' => 'xenial',
250             '18.04' => 'bionic',
251             '20.04' => 'focal',
252 14         107 }->{$info{linuxdistroversion}};
253 14         377 return \%info;
254             } else {
255 0         0 warn "WARNING: don't know how to handle '$line'";
256             }
257             } else {
258 0         0 warn "WARNING: no /etc/issue available";
259             }
260 0         0 return {};
261             }
262              
263             sub _is_linux_debian_like {
264 352     353   658 my(undef, $linuxdistro) = @_;
265 352         1834 $linuxdistro =~ m{^(debian|ubuntu|linuxmint)$};
266             }
267              
268             sub _is_linux_fedora_like {
269 206     207   390 my(undef, $linuxdistro) = @_;
270 206         1133 $linuxdistro =~ m{^(fedora|redhat|centos)$};
271             }
272              
273 15     16   171 sub _is_apt_installer { shift->{installer} =~m{^(apt-get|aptitude)$} }
274              
275             # Run a process in an elevated window, wait for its exit
276             sub _win32_run_elevated {
277 0     1   0 my($exe, @args) = @_;
278            
279 0 0       0 my $args = join " ", map { if(/[ "]/) { s!"!\\"!g; qq{"$_"} } else { $_ }} @args;
  0         0  
  0         0  
  0         0  
  0         0  
280              
281 0         0 my $ps1 = sprintf q{powershell -NonInteractive -NoProfile -Command "$process = Start-Process '%s' -PassThru -ErrorAction Stop -ArgumentList '%s' -Verb RunAs -Wait; Exit $process.ExitCode"},
282             $exe, $args;
283              
284 0         0 $ps1;
285             }
286              
287             sub _debug {
288 11943     11944   16177 my $self = shift;
289 11943 50       22860 if ($self->{debug}) {
290 0         0 print STDERR 'DEBUG: ';
291             print STDERR join('', map {
292 0 0       0 if (ref $_) {
  0         0  
293 0         0 Data::Dumper->new([$_])->Terse(1)->Indent(0)->Dump;
294             } else {
295 0         0 $_;
296             }
297             } @_);
298 0         0 print STDERR "\n";
299             }
300             }
301              
302             sub _map_cpandist {
303 18     19   49 my($self, $dist) = @_;
304              
305             # compat for older CPAN.pm (1.76)
306 18 50       140 if (!$dist->can('base_id')) {
307 7     7   73 no warnings 'once';
  7         71  
  7         18530  
308             *CPAN::Distribution::base_id = sub {
309 0     1   0 my $self = shift;
310 0         0 my $id = $self->id();
311 0         0 my $base_id = File::Basename::basename($id);
312 0         0 $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i;
313 0         0 return $base_id;
314 0         0 };
315             }
316              
317             # smartmatch for regexp/string/array without ~~, 5.8.x compat!
318             # also add support for numerical comparisons
319             my $smartmatch = sub ($$) {
320 3493     3493   7062 my($left, $right) = @_;
321 3493 100       7658 if (ref $right eq 'Regexp') {
    100          
    100          
322 30 100       369 return 1 if $left =~ $right;
323             } elsif (ref $right eq 'ARRAY') {
324 426 100       1825 return 1 if first { $_ eq $left } @$right;
  1015         2844  
325             } elsif (ref $right eq 'HASH') {
326 28         186 for my $op (keys %$right) {
327 31 50       216 if ($op !~ SUPPORTED_NUMERICAL_OPS_RX) {
328 0         0 die "Unsupported operator '$op', only supported: @{SUPPORTED_NUMERICAL_OPS()}";
  0         0  
329             }
330 31         81 my $val = $right->{$op};
331 31         83 my $code = 'no warnings q(numeric); $left '.$op.' $val';
332 31     2   4022 my $res = eval $code;
  2     2   26  
  2     2   5  
  2     2   125  
  2     2   21  
  2     2   6  
  2         93  
  2         17  
  2         4  
  2         69  
  2         21  
  2         4  
  2         105  
  2         21  
  2         4  
  2         101  
  2         15  
  2         5  
  2         66  
333 31 50       123 die "Evaluation of '$code' failed: $@" if $@;
334 31 100       272 return 0 if !$res;
335             }
336 5         34 return 1;
337             } else {
338 3009 100       10256 return 1 if $left eq $right;
339             }
340 18         126 };
341              
342 18         37 my $handle_mapping_entry; $handle_mapping_entry = sub {
343 5118     5118   8310 my($entry, $level) = @_;
344 5118         10840 for(my $map_i=0; $map_i <= $#$entry; $map_i++) {
345 7417         12280 my $key_or_subentry = $entry->[$map_i];
346 7417 100       13782 if (ref $key_or_subentry eq 'ARRAY') {
    100          
347 2249         6118 $self->_debug(' ' x $level . ' traverse another tree level');
348 2249         4156 my $res = $handle_mapping_entry->($key_or_subentry, $level+1);
349 2248 100 100     11020 return $res if $res && !$TRAVERSE_ONLY;
350             } elsif (ref $key_or_subentry eq 'CODE') {
351 1         29 my $res = $key_or_subentry->($self, $dist);
352 1 50 33     12 return $res if $res && !$TRAVERSE_ONLY;
353             } else {
354 5167         6939 my $key = $key_or_subentry;
355 5167         8047 my $match = $entry->[++$map_i];
356 5167         14976 $self->_debug(' ' x $level . " match '$key' against '", $match, "'");
357 5167 100       12806 if ($key eq 'cpandist') {
    100          
    100          
    100          
    100          
    100          
    100          
    50          
358 15 100 100     50 return 0 if !$smartmatch->($dist->base_id, $match) && !$TRAVERSE_ONLY;
359             } elsif ($key eq 'cpanmod') {
360 2854         4012 my $found = 0;
361 2854         5571 for my $mod ($dist->containsmods) {
362 2854         22252 $self->_debug(' ' x $level . " found module '$mod' in dist, check now against '", $match, "'");
363 2854 100       4554 if ($smartmatch->($mod, $match)) {
364 15         24 $found = 1;
365 15         26 last;
366             }
367             }
368 2854 100 100     10675 return 0 if !$found && !$TRAVERSE_ONLY;
369             } elsif ($key eq 'os') {
370 436 100 100     731 return 0 if !$smartmatch->($self->{os}, $match) && !$TRAVERSE_ONLY;
371             } elsif ($key eq 'osvers') {
372 16 100 100     55 return 0 if !$smartmatch->($self->{osvers}, $match) && !$TRAVERSE_ONLY;
373             } elsif ($key eq 'linuxdistro') {
374 596 100       2118 if ($match =~ m{^~(debian|fedora)$}) {
    100          
375 550         1337 my $method = "_is_linux_$1_like";
376 550         1597 $self->_debug(' ' x $level . " translate $match to $method");
377 550 50 66     1460 return 0 if !$self->$method($self->{linuxdistro}) && !$TRAVERSE_ONLY;
378             } elsif ($match =~ m{^~}) {
379 1         17 die "'like' matches only for debian and fedora";
380             } else {
381 45 50 33     97 return 0 if !$smartmatch->($self->{linuxdistro}, $match) && !$TRAVERSE_ONLY;
382             }
383             } elsif ($key eq 'linuxdistroversion') {
384 29 50 66     59 return 0 if !$smartmatch->($self->{linuxdistroversion}, $match) && !$TRAVERSE_ONLY;
385             } elsif ($key eq 'linuxdistrocodename') {
386 98 50 66     223 return 0 if !$smartmatch->($self->{linuxdistrocodename}, $match) && !$TRAVERSE_ONLY; # XXX should also do a smart codename comparison additionally!
387             } elsif ($key eq 'package') {
388 1123         3267 $self->_debug(' ' x $level . " found $match"); # XXX array?
389 1123         3382 return { package => $match };
390             } else {
391 0         0 die "Invalid key '$key'"; # XXX context/position?
392             }
393             }
394             }
395 18         137 };
396              
397 18 50       36 for my $entry (@{ $self->{mapping} || [] }) {
  18         84  
398 2869         4633 my $res = $handle_mapping_entry->($entry, 0);
399 2868 100 66     6607 if ($res && !$TRAVERSE_ONLY) {
400 10 100       96 return ref $res->{package} eq 'ARRAY' ? @{ $res->{package} } : $res->{package};
  2         27  
401             }
402             }
403              
404 7         40 ();
405             }
406              
407             sub _detect_dnf {
408 0     0   0 my @cmd = ('dnf', '--help');
409 0         0 require IPC::Open3;
410 0         0 require Symbol;
411 0         0 my $err = Symbol::gensym();
412 0         0 my $fh;
413 0         0 return eval {
414 0 0       0 if (my $pid = IPC::Open3::open3(undef, $fh, $err, @cmd)) {
415 0         0 waitpid $pid, 0;
416 0         0 return $? == 0;
417             }
418             };
419             }
420              
421             sub _find_missing_deb_packages {
422 5     5   26 my($self, @packages) = @_;
423 5 100       22 return () if !@packages;
424              
425             # taken from ~/devel/deb-install.pl
426 4         13 my %seen_packages;
427             my @missing_packages;
428              
429 4         16 my @cmd = ('dpkg-query', '-W', '-f=${Package} ${Status}\n', @packages);
430 4         1755 require IPC::Open3;
431 4         10698 require Symbol;
432 4         35 my $err = Symbol::gensym();
433 4         107 my $fh;
434 4 50       22 my $pid = IPC::Open3::open3(undef, $fh, $err, @cmd)
435             or die "Error running '@cmd': $!";
436 4         67491 while(<$fh>) {
437 0         0 chomp;
438 0 0       0 if (m{^(\S+) (.*)}) {
439 0 0       0 if ($2 ne 'install ok installed') {
440 0         0 push @missing_packages, $1;
441             }
442 0         0 $seen_packages{$1} = 1;
443             } else {
444 0         0 warn "ERROR: cannot parse $_, ignore line...\n";
445             }
446             }
447 4         176 waitpid $pid, 0;
448 4         69 for my $package (@packages) {
449 6 50       69 if (!$seen_packages{$package}) {
450 6         77 push @missing_packages, $package;
451             }
452             }
453 4         346 @missing_packages;
454             }
455              
456             sub _find_missing_rpm_packages {
457 0     0   0 my($self, @packages) = @_;
458 0 0       0 return () if !@packages;
459              
460 0         0 my @missing_packages;
461              
462             {
463 0         0 my %packages = map{($_,1)} @packages;
  0         0  
  0         0  
464              
465 0         0 local $ENV{LC_ALL} = 'C';
466 0         0 my @cmd = ('rpm', '-q', @packages);
467 0 0       0 open my $fh, '-|', @cmd
468             or die "Error running '@cmd': $!";
469 0         0 while(<$fh>) {
470 0 0       0 if (m{^package (\S+) is not installed}) {
471 0         0 my $package = $1;
472 0 0       0 if (!exists $packages{$package}) {
473 0         0 die "Unexpected: package $package listed as non-installed, but not queries in '@cmd'?!";
474             }
475 0         0 push @missing_packages, $package;
476             }
477             }
478             }
479              
480 0         0 @missing_packages;
481             }
482              
483             sub _find_missing_freebsd_pkg_packages {
484 0     0   0 my($self, @packages) = @_;
485 0 0       0 return () if !@packages;
486              
487 0         0 my @missing_packages;
488 0         0 for my $package (@packages) {
489 0         0 my @cmd = ('pkg', 'info', '--exists', $package);
490 0         0 system @cmd;
491 0 0       0 if ($? != 0) {
492 0         0 push @missing_packages, $package;
493             }
494             }
495              
496 0         0 @missing_packages;
497             }
498              
499             sub _find_missing_openbsd_pkg_packages {
500 0     0   0 my($self, @packages) = @_;
501 0 0       0 return () if !@packages;
502              
503 0         0 require IPC::Open3;
504 0         0 require Symbol;
505              
506 0         0 my @missing_packages;
507 0         0 for my $package (@packages) {
508 0         0 my $err = Symbol::gensym();
509 0         0 my $fh;
510             my $package_in_repository;
511 0         0 eval {
512 0 0       0 if (my $pid = IPC::Open3::open3(undef, $fh, $err, 'pkg_info', $package)) {
513 0         0 waitpid $pid, 0;
514 0 0       0 if ($? == 0) {
515 0         0 $package_in_repository = 1;
516             }
517             }
518             };
519 0 0       0 if ($package_in_repository) {
520 0         0 my @cmd = ('pkg_info', '-q', '-e', "${package}->=0");
521 0         0 system @cmd;
522 0 0       0 if ($? != 0) {
523 0         0 push @missing_packages, $package;
524             }
525             }
526             }
527              
528 0         0 @missing_packages;
529             }
530              
531             sub _find_missing_homebrew_packages {
532 0     0   0 my($self, @packages) = @_;
533 0 0       0 return () if !@packages;
534              
535 0         0 my @missing_packages;
536 0         0 for my $package (@packages) {
537 0         0 my @cmd = ('brew', 'ls', '--versions', $package);
538 0 0       0 open my $fh, '-|', @cmd
539             or die "Error running @cmd: $!";
540 0         0 my $has_package;
541 0         0 while(<$fh>) {
542 0         0 $has_package = 1;
543 0         0 last;
544             }
545 0         0 close $fh; # earlier homebrew versions returned always 0,
546             # newer (since Oct 2016) return 1 if the package is
547             # missing
548 0 0       0 if (!$has_package) {
549 0         0 push @missing_packages, $package;
550             }
551             }
552 0         0 @missing_packages;
553             }
554              
555             sub _find_missing_chocolatey_packages {
556 0     0   0 my($self, @packages) = @_;
557 0 0       0 return () if !@packages;
558              
559             my %installed_packages = map {
560 0 0       0 /^(.*)\|(.*)$/
561             or next;
562 0         0 $1 => $2
563             } grep {
564 0         0 /^(.*)\|(.*)$/
  0         0  
565             } `$self->{installer} list --localonly --limit-output`;
566 0         0 my @missing_packages = grep { ! $installed_packages{ $_ }} @packages;
  0         0  
567 0         0 @missing_packages;
568             }
569              
570             sub _filter_uninstalled_packages {
571 4     4   2585 my($self, @packages) = @_;
572 4         17 my $find_missing_packages;
573 4 50 0     31 if ($self->_is_apt_installer) {
    0 0        
    0          
    0          
    0          
    0          
574 4         20 $find_missing_packages = '_find_missing_deb_packages';
575             } elsif (($self->{installer} eq 'yum') || ($self->{installer} eq 'dnf')) {
576 0         0 $find_missing_packages = '_find_missing_rpm_packages';
577             } elsif ($self->{os} eq 'freebsd' || $self->{os} eq 'dragonfly') {
578 0         0 $find_missing_packages = '_find_missing_freebsd_pkg_packages';
579             } elsif ($self->{os} eq 'openbsd') {
580 0         0 $find_missing_packages = '_find_missing_openbsd_pkg_packages';
581             } elsif ($self->{os} eq 'MSWin32') {
582 0         0 $find_missing_packages = '_find_missing_chocolatey_packages';
583             } elsif ($self->{installer} eq 'homebrew') {
584 0         0 $find_missing_packages = '_find_missing_homebrew_packages';
585             } else {
586 0         0 warn "check for installed packages is NYI for $self->{os}/$self->{linuxdistro}";
587             }
588 4 50       24 if ($find_missing_packages) {
589 4         15 my @plain_packages;
590             my @missing_packages;
591 4         19 for my $package_spec (@packages) {
592 5 100       31 if ($package_spec =~ m{\|}) { # has alternatives
593 1         18 my @single_packages = split /\s*\|\s*/, $package_spec;
594 1         21 my @missing_in_packages_spec = $self->$find_missing_packages(@single_packages);
595 1 50       35 if (@missing_in_packages_spec == @single_packages) {
596 1         29 push @missing_packages, $single_packages[0];
597             }
598             } else {
599 4         11 push @plain_packages, $package_spec;
600             }
601             }
602 4         33 push @missing_packages, $self->$find_missing_packages(@plain_packages);
603 4         66 @packages = @missing_packages;
604             }
605 4         81 @packages;
606             }
607              
608             sub _install_packages_commands {
609 11     11   74 my($self, @packages) = @_;
610 11         42 my @pre_cmd;
611             my @install_cmd;
612              
613             # sudo or not?
614 11 100       95 if ($self->{installer} eq 'homebrew') {
    50          
615             # may run as unprivileged user
616             } elsif ($self->{installer} eq 'chocolatey') {
617             # no sudo on Windows systems?
618             } else {
619 10 50       106 if ($< != 0) {
620 0         0 push @install_cmd, 'sudo';
621             }
622             }
623              
624             # the installer executable
625 11 100       50 if ($self->{installer} eq 'homebrew') {
626 1         4 push @install_cmd, 'brew';
627             } else {
628 10         46 push @install_cmd, $self->{installer};
629             }
630              
631             # batch, default or interactive
632 11 100       42 if ($self->{batch}) {
633 3 50 0     36 if ($self->_is_apt_installer) {
    0          
    0          
    0          
634 3         28 push @install_cmd, '-y';
635             } elsif (($self->{installer} eq 'yum') || ($self->{installer} eq 'dnf')) {
636 0         0 push @install_cmd, '-y';
637             } elsif ($self->{installer} eq 'pkg') { # FreeBSD's pkg
638             # see below
639             } elsif ($self->{installer} eq 'homebrew') {
640             # batch by default
641             } else {
642 0         0 warn "batch=1 NYI for $self->{installer}";
643             }
644             } else {
645 8 100 100     19 if ($self->_is_apt_installer) {
    100          
    100          
    50          
    100          
646 3         18 @pre_cmd = ('sh', '-c', 'echo -n "Install package(s) '."@packages".'? (y/N) "; read yn; [ "$yn" = "y" ]');
647             } elsif (($self->{installer} eq 'yum') || ($self->{installer} eq 'dnf')) {
648             # interactive by default
649             } elsif ($self->{installer} eq 'pkg') { # FreeBSD's pkg
650             # see below
651             } elsif ($self->{installer} =~ m{^(chocolatey)$}) {
652             # Nothing to do here
653             } elsif ($self->{installer} eq 'homebrew') {
654             # the sh builtin echo does not understand -n -> use printf
655 1         7 @pre_cmd = ('sh', '-c', 'printf %s "Install package(s) '."@packages".'? (y/N) "; read yn; [ "$yn" = "y" ]');
656             } else {
657 1         16 warn "batch=0 NYI for $self->{installer}";
658             }
659             }
660              
661             # special options
662 11 100       49 if ($self->{installer} eq 'pkg') { # FreeBSD's pkg
663 1         2 push @install_cmd, '--option', 'LOCK_RETRIES=86400'; # wait quite long in case there are concurrent pkg runs
664             }
665              
666             # the installer subcommand
667 11 100       39 if ($self->{installer} ne 'pkg_add') {
668 10         26 push @install_cmd, 'install';
669             }
670              
671             # post options
672 11 50 66     82 if ($self->{batch} && $self->{installer} eq 'pkg') {
673 0         0 push @install_cmd, '-y';
674             }
675 11 50 66     58 if ($self->{batch} && $self->{installer} eq 'chocolatey') {
676 0         0 push @install_cmd, '-y';
677             }
678 11 50 66     52 if ($self->{batch} && $self->{installer} eq 'pkg_add') {
679 0         0 push @install_cmd, '-I';
680             }
681              
682 11         24 push @install_cmd, @packages;
683            
684 11 50       34 if ($self->{os} eq 'MSWin32') {
685             # Wrap the thing in our small powershell program
686 0         0 @install_cmd = _win32_run_elevated(@install_cmd);
687             };
688              
689 11 100       59 ((@pre_cmd ? \@pre_cmd : ()), \@install_cmd);
690             }
691              
692             1;
693              
694             __END__