File Coverage

blib/lib/Sys/OsPackage/Driver/Suse.pm
Criterion Covered Total %
statement 12 50 24.0
branch 0 22 0.0
condition n/a
subroutine 4 9 44.4
pod 0 5 0.0
total 16 86 18.6


line stmt bran cond sub pod time code
1             # Sys::OsPackage::Driver::Suse
2             # ABSTRACT: SUSE/OpenSUSE Zypper packaging handler for Sys::OsPackage
3             # Copyright (c) 2022 by Ian Kluft
4             # Open Source license Perl's Artistic License 2.0:
5             # SPDX-License-Identifier: Artistic-2.0
6              
7             # This module is maintained for minimal dependencies so it can build systems/containers from scratch.
8              
9             ## no critic (Modules::RequireExplicitPackage)
10             # This resolves conflicting Perl::Critic rules which want package and strictures each before the other
11 2     2   1208 use strict;
  2         3  
  2         73  
12 2     2   10 use warnings;
  2         3  
  2         90  
13 2     2   9 use utf8;
  2         3  
  2         9  
14             ## use critic (Modules::RequireExplicitPackage)
15              
16             package Sys::OsPackage::Driver::Suse;
17             $Sys::OsPackage::Driver::Suse::VERSION = '0.4.0';
18 2     2   150 use parent "Sys::OsPackage::Driver";
  2         37  
  2         18  
19              
20             # check if packager command found (zypper)
21             sub pkgcmd
22             {
23 0     0 0   my ( $class, $ospkg ) = @_;
24              
25 0 0         return ( defined $ospkg->sysenv("zypper") ? 1 : 0 );
26             }
27              
28             # find name of package for Perl module (zypper)
29             sub modpkg
30             {
31 0     0 0   my ( $class, $ospkg, $args_ref ) = @_;
32 0 0         return if not $class->pkgcmd($ospkg);
33              
34             #return join("-", "perl", @{$args_ref->{mod_parts}}); # zypper/rpm format for Perl module packages
35 0           my @querycmd = $ospkg->sysenv("zypper");
36             my @pkglist = sort $ospkg->capture_cmd(
37             { list => 1 },
38             $ospkg->sudo_cmd(), @querycmd,
39             qw(--non-interactive --quiet --terse search --provides --type=package --match-exact),
40 0           "'perl(" . $args_ref->{module} . ")'"
41             );
42             $ospkg->debug()
43             and print STDERR "debug("
44             . __PACKAGE__
45             . "->modpkg): "
46 0 0         . $args_ref->{module} . " -> "
47             . join( " ", @pkglist ) . "\n";
48 0 0         return if not scalar @pkglist; # empty list means nothing found
49 0           splice @pkglist, 0, 3; # remove table header in 3 leading lines
50 0           my $pkg_found = $pkglist[-1]; # get last entry from table
51 0           $pkg_found =~ s/^[^\|]*\|\s*//x; # remove 1st column
52 0           $pkg_found =~ s/\s*\|.*$//x; # remove 3rd & following columns
53 0           return $pkg_found;
54             }
55              
56             # find named package in repository (zypper)
57             sub find
58             {
59 0     0 0   my ( $class, $ospkg, $args_ref ) = @_;
60 0 0         return if not $class->pkgcmd($ospkg);
61              
62 0           my @querycmd = $ospkg->sysenv("zypper");
63             my @pkglist = sort $ospkg->capture_cmd(
64             { list => 1 },
65             $ospkg->sudo_cmd(), @querycmd,
66             qw(--non-interactive --quiet --terse search --provides --type=package --match-exact),
67             $args_ref->{pkg}
68 0           );
69 0 0         return if not scalar @pkglist; # empty list means nothing found
70 0           splice @pkglist, 0, 3; # remove table header in 3 leading lines
71 0           my $pkg_found = $pkglist[-1]; # get last entry from table
72 0           $pkg_found =~ s/^[^\|]*\|\s*//x; # remove 1st column
73 0           $pkg_found =~ s/\s*\|.*$//x; # remove 3rd & following columns
74 0           return $pkg_found;
75             }
76              
77             # install package (zypper)
78             sub install
79             {
80 0     0 0   my ( $class, $ospkg, $args_ref ) = @_;
81 0 0         return if not $class->pkgcmd($ospkg);
82              
83             # determine packages to install
84 0           my @packages;
85 0 0         if ( exists $args_ref->{pkg} ) {
86 0 0         if ( ref $args_ref->{pkg} eq "ARRAY" ) {
87 0           push @packages, @{ $args_ref->{pkg} };
  0            
88             } else {
89 0           push @packages, $args_ref->{pkg};
90             }
91             }
92              
93             # install the packages
94 0           my $pkgcmd = $ospkg->sysenv("zypper");
95 0           return $ospkg->run_cmd( $ospkg->sudo_cmd(), $pkgcmd, qw(--non-interactive --quiet --terse install), @packages );
96             }
97              
98             # check if an OS package is installed locally
99             sub is_installed
100             {
101 0     0 0   my ( $class, $ospkg, $args_ref ) = @_;
102 0 0         return if not $class->pkgcmd($ospkg);
103              
104             # check if package is installed
105 0           my $querycmd = $ospkg->sysenv("rpm");
106 0           my @pkglist = $ospkg->capture_cmd( { list => 1 }, $ospkg->sudo_cmd(), $querycmd, qw(--query), $args_ref->{pkg} );
107 0 0         return ( scalar @pkglist > 0 ) ? 1 : 0;
108             }
109              
110             1;
111              
112             =pod
113              
114             =encoding UTF-8
115              
116             =head1 NAME
117              
118             Sys::OsPackage::Driver::Suse - SUSE/OpenSUSE Zypper packaging handler for Sys::OsPackage
119              
120             =head1 VERSION
121              
122             version 0.4.0
123              
124             =head1 SYNOPSIS
125              
126             my $ospkg = Sys::OsPackage->instance();
127              
128             # check if packaging commands exist for this system
129             if (not $ospkg->call_pkg_driver(op => "implemented")) {
130             return 0;
131             }
132              
133             # find OS package name for Perl module
134             my $pkgname = $ospkg->call_pkg_driver(op => "find", module => $module);
135              
136             # install a Perl module as an OS package
137             my $result1 = $ospkg->call_pkg_driver(op => "modpkg", module => $module);
138              
139             # install an OS package
140             my $result2 = $ospkg->call_pkg_driver(op => "install", pkg => $pkgname);
141              
142             =head1 DESCRIPTION
143              
144             ⛔ This is for Sys::OsPackage internal use only.
145              
146             The Sys::OsPackage method call_pkg_driver() will call the correct driver for the running platform.
147             The driver implements these methods: I, I, I, I, I and I.
148              
149             =head1 SEE ALSO
150              
151             OpenSuSE Linux docs: Portal:Zypper L
152              
153             GitHub repository for Sys::OsPackage: L
154              
155             =head1 BUGS AND LIMITATIONS
156              
157             Please report bugs via GitHub at L
158              
159             Patches and enhancements may be submitted via a pull request at L
160              
161             =head1 LICENSE INFORMATION
162              
163             Copyright (c) 2022 by Ian Kluft
164              
165             This module is distributed in the hope that it will be useful, but it is provided “as is” and without any express or implied warranties. For details, see the full text of the license in the file LICENSE or at L.
166              
167             =head1 AUTHOR
168              
169             Ian Kluft
170              
171             =head1 COPYRIGHT AND LICENSE
172              
173             This software is Copyright (c) 2022 by Ian Kluft.
174              
175             This is free software, licensed under:
176              
177             The Artistic License 2.0 (GPL Compatible)
178              
179             =cut
180              
181             __END__