File Coverage

lib/Rex/Pkg/FreeBSD.pm
Criterion Covered Total %
statement 20 65 30.7
branch 0 16 0.0
condition 0 3 0.0
subroutine 7 12 58.3
pod 0 5 0.0
total 27 101 26.7


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Pkg::FreeBSD;
6              
7 1     1   15 use v5.12.5;
  1         6  
8 1     1   8 use warnings;
  1         2  
  1         41  
9              
10             our $VERSION = '1.14.3'; # VERSION
11              
12 1     1   5 use Rex::Helper::Run;
  1         2  
  1         52  
13 1     1   6 use Rex::Commands::File;
  1         3  
  1         10  
14 1     1   7 use Rex::Pkg::Base;
  1         2  
  1         8  
15 1     1   26 use base qw(Rex::Pkg::Base);
  1         3  
  1         79  
16 1     1   8 use Net::OpenSSH::ShellQuoter;
  1         3  
  1         14  
17              
18             sub new {
19 0     0 0   my $that = shift;
20 0   0       my $proto = ref($that) || $that;
21 0           my $self = $proto->SUPER::new(@_);
22              
23 0           bless( $self, $proto );
24              
25             # Check if pkg is actually bootstraped (installed and activated)
26 0           i_run "pkg -N", fail_ok => 1;
27 0 0         if ( $? != 0 ) {
28 0           i_run "pkg bootstrap", env => { 'ASSUME_ALWAYS_YES' => 'true' };
29             }
30              
31             $self->{commands} = {
32 0           install => 'pkg install -q -y %s',
33             install_glob => 'pkg install -q -y -g %s',
34             install_version => 'pkg install -q -y %s',
35             remove => 'pkg remove -q -y %s',
36             remove_glob => 'pkg remove -q -y -g %s',
37             query => 'pkg info',
38             update_package_db => 'pkg update -q -f',
39              
40             # pkg can't update system yet, only packages
41             update_system => 'pkg upgrade -q -y',
42             };
43              
44 0           return $self;
45             }
46              
47             sub bulk_install {
48 0     0 0   my ( $self, $packages_aref, $option ) = @_;
49              
50             # makes no sense to specify the same version for several packages
51 0           delete $option->{version};
52 0           $self->update( "@{$packages_aref}", $option );
  0            
53              
54 0           return 1;
55             }
56              
57             sub remove {
58 0     0 0   my ( $self, $pkg ) = @_;
59              
60 0           my $pkg_version = '';
61              
62 0 0         if ( $pkg !~ /\*/ ) {
63 0           my ($pkg_found) = grep { $_->{"name"} eq "$pkg" } $self->get_installed();
  0            
64 0           $pkg_version = '-' . $pkg_found->{"version"};
65             }
66              
67 0           return $self->SUPER::remove("$pkg$pkg_version");
68             }
69              
70             sub is_installed {
71 0     0 0   my ( $self, $pkg, $option ) = @_;
72 0           my $version = $option->{version};
73              
74 0 0         Rex::Logger::debug(
75             "Checking if $pkg" . ( $version ? "-$version" : "" ) . " is installed" );
76              
77             # only need -g if pkg is a glob
78 0           my $extra_args = '';
79 0 0         if ( $pkg =~ /\*/ ) {
80              
81             # quote the pkg glob so it will work
82 0           my $exec = Rex::Interface::Exec->create;
83 0           my $quoter = Net::OpenSSH::ShellQuoter->quoter( $exec->shell->name );
84 0           $pkg = $quoter->quote($pkg);
85 0           $extra_args = $extra_args . ' -g ';
86             }
87              
88             # pkg info -e allow get quick answer about is pkg installed or not.
89             my $command =
90             $self->{commands}->{query}
91 0 0         . $extra_args
92             . " -e $pkg"
93             . ( $version ? "-$version" : "" );
94 0           i_run $command, fail_ok => 1;
95              
96 0 0         if ( $? != 0 ) {
97 0 0         Rex::Logger::debug(
98             "$pkg" . ( $version ? "-$version" : "" ) . " is NOT installed." );
99 0           return 0;
100             }
101              
102             Rex::Logger::debug(
103 0 0         "$pkg" . ( $version ? "-$version" : "" ) . " is installed." );
104 0           return 1;
105              
106             }
107              
108             sub get_installed {
109 0     0 0   my ($self) = @_;
110              
111 0           my @lines = i_run $self->{commands}->{query};
112              
113 0           my @pkg;
114              
115 0           for my $line (@lines) {
116 0           my ( $pkg_name_v, $descr ) = split( /\s/, $line, 2 );
117              
118 0           my ( $pkg_name, $pkg_version ) = ( $pkg_name_v =~ m/^(.*)-(.*?)$/ );
119              
120 0           push(
121             @pkg,
122             {
123             name => $pkg_name,
124             version => $pkg_version,
125             }
126             );
127             }
128              
129 0           return @pkg;
130             }
131              
132             1;