summaryrefslogtreecommitdiff
path: root/rpmorphan-lib.pl
diff options
context:
space:
mode:
Diffstat (limited to 'rpmorphan-lib.pl')
-rwxr-xr-xrpmorphan-lib.pl792
1 files changed, 792 insertions, 0 deletions
diff --git a/rpmorphan-lib.pl b/rpmorphan-lib.pl
new file mode 100755
index 0000000..5eacbcc
--- /dev/null
+++ b/rpmorphan-lib.pl
@@ -0,0 +1,792 @@
+#!/usr/bin/perl
+###############################################################################
+# rpmorphan-lib.pl
+#
+# Copyright (C) 2006 by Eric Gerbier
+# Bug reports to: gerbier@users.sourceforge.net
+# $Id: rpmorphan-1.11 | rpmorphan-lib.pl | Wed Aug 1 09:36:43 2012 +0200 | Eric Gerbier $
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+###############################################################################
+use strict;
+use warnings;
+
+use English '-no_match_vars';
+
+use Data::Dumper; # debug
+use File::stat; # get_last_access
+
+## no critic (RequireCheckingReturnValueOfEval)
+
+# the code should use no "print" calls
+# but use instead debug, warning, info calls
+###############################################################################
+sub nodebug {
+ return;
+}
+###############################################################################
+sub backend_debug {
+ my $text = $_[0];
+ print "debug $text\n";
+ return;
+}
+###############################################################################
+# change debug subroutine
+# this way seems better than previous one as
+# - it does not need any "global" verbose variable
+# - it suppress any verbose test (quicker)
+sub init_debug($) {
+ my $verbose = shift @_;
+
+ # to avoid error messages
+ ## no critic ( NoWarnings );
+ no warnings 'redefine';
+ ## use critic;
+
+ if ($verbose) {
+ *debug = \&backend_debug;
+ }
+ else {
+ *debug = \&nodebug;
+ }
+
+ use warnings 'all';
+ return;
+}
+###############################################################################
+# used to print warning messages
+sub warning($) {
+ my $text = shift @_;
+ warn "WARNING $text\n";
+ return;
+}
+###############################################################################
+# used to print normal messages
+sub info($) {
+ my $text = shift @_;
+ print "$text\n";
+ return;
+}
+###############################################################################
+sub print_version($) {
+ my $version = shift @_;
+ info("$PROGRAM_NAME version $version");
+ return;
+}
+#########################################################
+# used to check on option
+sub is_set($$) {
+ my $rh_opt = shift @_; # hash of program arguments
+ my $key = shift @_; # name of desired option
+
+ #debug("is_set $key");
+ my $r_value = $rh_opt->{$key};
+ return ${$r_value};
+}
+#########################################################
+sub is_verbose($) {
+ my $rh_opt = shift @_; # hash of program arguments
+
+ return is_set( $rh_opt, 'verbose' );
+}
+#########################################################
+# apply a filter on package list according program options
+sub rpmfilter($$) {
+ my $rh_opt = shift @_;
+ my $rh_list_pac = shift @_;
+
+ display_status('apply filters');
+
+ # we just want the list of keys
+ my @list = keys %{$rh_list_pac};
+
+ if ( is_set( $rh_opt, 'all' ) ) {
+ debug('all');
+ return @list;
+ }
+ else {
+ debug('guess');
+
+ my @filtered_list;
+ if ( is_set( $rh_opt, 'guess-perl' ) ) {
+ debug('guess-perl');
+ my @res = grep { /^perl/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-python' ) ) {
+ my @res = grep { /^python/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-pike' ) ) {
+ my @res = grep { /^pike/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-ruby' ) ) {
+ my @res = grep { /^ruby/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-common' ) ) {
+ my @res = grep { /-common$/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-data' ) ) {
+ my @res = grep { /-data$/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-doc' ) ) {
+ my @res = grep { /-doc$/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-dev' ) ) {
+ my @res = grep { /-devel$/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-lib' ) ) {
+ my @res = grep { /^lib/ } @list;
+ push @filtered_list, @res;
+ }
+ if ( is_set( $rh_opt, 'guess-custom' ) ) {
+ my $regex = ${ $rh_opt->{'guess-custom'} };
+ my @res = grep { /$regex/ } @list;
+ push @filtered_list, @res;
+ }
+ return @filtered_list;
+ }
+}
+#########################################################
+# difference between 2 date in unix format
+# return in days
+sub diff_date($$) {
+ my $now = shift @_; # current
+ my $time = shift @_; #
+
+ # convert from seconds to days
+ ## no critic(ProhibitParensWithBuiltins,ProhibitMagicNumbers)
+ return int( ( $now - $time ) / 86_400 );
+}
+#########################################################
+# return the date (unix format) of last access on a package
+# (scan all inodes for atime) and the name of the file
+sub get_last_access($) {
+ my $ra_files = shift @_; # array of file names
+
+ my $last_date = 0; # means a very old date for linux : 1970
+ my $last_file = q{};
+ FILE: foreach my $file ( @{$ra_files} ) {
+ next FILE unless ( -e $file );
+ my $stat = stat $file;
+ my $atime = $stat->atime();
+
+ if ( $atime > $last_date ) {
+ $last_date = $atime;
+ $last_file = $file;
+ }
+ }
+ return ( $last_date, $last_file );
+}
+#########################################################
+# depending the cache option, return a command to execute
+# - as an rpm query (piped)
+# - as a cache file to open
+sub init_cache($) {
+ my $rh_opt = shift @_; # hash of program arguments
+
+ # the main idea is to reduce the number of call to rpm in order to gain time
+ # the ';' separator is used to separate fields
+ # the ',' separator is used to separate data in fields arrays
+
+ # note : we do not ask for PROVIDEFLAGS PROVIDEVERSION
+ # REQUIREFLAGS REQUIREVERSION
+
+ my $suggests = ( is_set( $rh_opt, 'suggests' ) ) ? '[%{SUGGESTS},]' : q{};
+
+ my $rpm_cmd =
+"rpm -qa --queryformat '%{NAME};[%{REQUIRENAME},]$suggests;[%{PROVIDES},];[%{FILENAMES},];%{INSTALLTIME}\n' 2>/dev/null";
+ my $cache_file = '/tmp/rpmorphan.cache';
+ my $fh_cache;
+ my $cmd;
+
+ if ( is_set( $rh_opt, 'clear-cache' ) ) {
+ unlink $cache_file if ( -f $cache_file );
+ }
+
+ if ( is_set( $rh_opt, 'use-cache' ) ) {
+ if ( -f $cache_file ) {
+
+ # cache exists : use it
+ $cmd = $cache_file;
+ display_status("use cache file $cache_file");
+ }
+ else {
+
+ # use rpm command
+ $cmd = "$rpm_cmd |";
+
+ # and create cache file
+ ## no critic (RequireBriefOpen)
+ if ( open $fh_cache, '>', $cache_file ) {
+ display_status("create cache file $cache_file");
+ }
+ else {
+ warning("can not create cache file $cache_file : $ERRNO");
+ }
+ }
+ }
+ else {
+
+ # output may be long, so we use a pipe to avoid to store a big array
+ $cmd = "$rpm_cmd |";
+ display_status('read rpm data');
+
+ unlink $cache_file if ( -f $cache_file );
+ }
+
+ return ( $cmd, $fh_cache );
+}
+#########################################################
+## no critic (ProhibitManyArgs)
+sub analyse_rpm_info($$$$$$$$$$) {
+ my $name = shift @_; # current package name
+ my $ra_prov = shift @_; # data from database on name
+ my $ra_req = shift @_; # idem
+ my $ra_files = shift @_; # idem
+ my $rh_objects = shift @_;
+ my $rh_provides = shift @_;
+ my $rh_files = shift @_;
+ my $rh_depends = shift @_;
+ my $rh_virtual = shift @_;
+ my $rh_requires = shift @_;
+
+ ## use critic;
+
+ # we do not use version in keys
+ # so we only keep the last seen data for a package name
+ if ( exists $rh_provides->{$name} ) {
+ debug("duplicate package $name");
+ }
+
+ VIRTUAL: foreach my $p ( @{$ra_prov}, @{$ra_files} ) {
+
+ # do not add files
+ #next VIRTUAL if ( $p =~ m!^/! );
+
+ # some bad package may provide more than on time the same object
+ if ( ( exists $rh_objects->{$p} )
+ && ( $rh_objects->{$p} ne $name ) )
+ {
+
+ # method 1 (old)
+ # we do not use who provide this virtual for now
+ #$rh_virtual->{$p} = 1;
+
+ # method 2 (current)
+ # to improve the code, we can use virtual as a counter
+ # ( as a garbage collector )
+ # so we can remove all providing except the last one
+ if ( !exists $rh_virtual->{$p} ) {
+
+ # add previous data
+ $rh_virtual->{$p}{ $rh_objects->{$p} } = 1;
+ }
+
+ # add new virtual
+ $rh_virtual->{$p}{$name} = 1;
+ }
+ else {
+
+ # keep memory of seen "provided"
+ $rh_objects->{$p} = $name;
+ }
+ }
+
+ # $name package provide @prov
+ # file are also included in "provide"
+ push @{ $rh_provides->{$name} }, @{$ra_prov}, @{$ra_files};
+
+ # list are necessary for access-time option
+ push @{ $rh_files->{$name} }, @{$ra_files};
+
+ # this will be helpfull when recursive remove package
+ push @{ $rh_requires->{$name} }, @{$ra_req};
+
+ # build a hash for dependencies
+ foreach my $require ( @{$ra_req} ) {
+
+ # we have to suppress auto-depends (ex : ark package)
+ my $flag_auto = 0;
+ PROVIDE: foreach my $p ( @{$ra_prov} ) {
+ if ( $require eq $p ) {
+ $flag_auto = 1;
+
+ #debug("skip auto-depency on $name");
+ last PROVIDE;
+ }
+ }
+
+ # $name depends from $require
+ # exemple : depends { 'afick' } { afick-gui } = 1
+ # push @{ $rh_depends->{$require} }, $name unless $flag_auto;
+ # we use a hash to help when we have to delete data (on recursive remove)
+ $rh_depends->{$require}{$name} = 1 unless $flag_auto;
+ }
+ return;
+}
+#########################################################
+# read rpm information about all installed packages
+# can be from database, or from rpmorphan cache
+sub read_rpm_data_base($$$$$$$) {
+ my $rh_opt = shift @_; # hash of program arguments
+ my $rh_provides = shift @_;
+ my $rh_install_time = shift @_;
+ my $rh_files = shift @_;
+ my $rh_depends = shift @_;
+ my $rh_virtual = shift @_;
+ my $rh_requires = shift @_;
+
+ display_status('read rpm data using base RPM');
+ my ( $cmd, $fh_cache ) = init_cache($rh_opt);
+
+ # because we can open a pipe or a cache, it is not possible to use
+ # the 3 arg form of open
+ ## no critic (ProhibitTwoArgOpen,RequireBriefOpen);
+ my $fh;
+ if ( !open $fh, $cmd ) {
+
+ # no critic;
+ die "can not open $cmd : $ERRNO\n";
+ ## use critic
+ }
+ debug('1 : analysis');
+ my %objects;
+ while (<$fh>) {
+
+ # write cache
+ print {$fh_cache} $_ if ($fh_cache);
+
+ my ( $name, $req, $prov, $files, $install_time ) = split /;/, $_;
+
+ # install time are necessary for install-time option
+ $rh_install_time->{$name} = $install_time;
+
+ # see rpm query format in init_cache
+ my $delim = q{,};
+ my @prov = split /$delim/, $prov;
+ my @req = split /$delim/, $req;
+ my @files = split /$delim/, $files;
+
+ analyse_rpm_info(
+ $name, \@prov, \@req, \@files,
+ \%objects, $rh_provides, $rh_files, $rh_depends,
+ $rh_virtual, $rh_requires
+ );
+
+ }
+ close $fh or warning("problem to close rpm command : $ERRNO");
+
+ # close cache if necessary
+ if ($fh_cache) {
+ close $fh_cache or warning("problem to close cache file : $ERRNO");
+ }
+ return;
+}
+#########################################################
+# read database info by use of RPM2 module
+sub read_rpm_data_rpm2($$$$$$$) {
+ my $rh_opt = shift @_; # hash of program arguments
+ my $rh_provides = shift @_;
+ my $rh_install_time = shift @_;
+ my $rh_files = shift @_;
+ my $rh_depends = shift @_;
+ my $rh_virtual = shift @_;
+ my $rh_requires = shift @_;
+
+ # cache ?
+ # acces to data by rpm2 should be fast,
+ # so do not need cache
+ # and init_cache works with a command to exec
+ # not with a perl module
+
+ display_status('read rpm data using RPM2');
+ import RPM2;
+ my $db = RPM2->open_rpm_db();
+
+ my $flag_suggests = is_set( $rh_opt, 'suggests' );
+
+ debug('1 : analysis');
+ my %objects;
+
+ my $i = $db->find_all_iter();
+ while ( my $pkg = $i->next ) {
+
+ my $name = $pkg->name;
+ my $install_time = $pkg->installtime;
+ $rh_install_time->{$name} = $install_time;
+
+ my @req = $pkg->requires;
+ my @prov = $pkg->provides;
+ my @files = $pkg->files;
+
+ if ($flag_suggests) {
+ my @suggests = $pkg->tag('SUGGESTS');
+
+ #debug("suggests for $name : " . join ' ', @suggests);
+ push @req, @suggests;
+ }
+
+ analyse_rpm_info(
+ $name, \@prov, \@req, \@files,
+ \%objects, $rh_provides, $rh_files, $rh_depends,
+ $rh_virtual, $rh_requires
+ );
+ }
+ return;
+}
+#########################################################
+# URPM return dependencies as perl[ = 5.8]
+# we have to suppress the version and only keep the package
+sub clean_rel($) {
+ my $ra = shift @_;
+
+ foreach my $elem ( @{$ra} ) {
+ $elem =~ s/\[.*\]//;
+ }
+ return;
+}
+#########################################################
+# read database info by use of URPM module
+sub read_rpm_data_urpm($$$$$$$) {
+ my $rh_opt = shift @_; # hash of program arguments
+ my $rh_provides = shift @_;
+ my $rh_install_time = shift @_;
+ my $rh_files = shift @_;
+ my $rh_depends = shift @_;
+ my $rh_virtual = shift @_;
+ my $rh_requires = shift @_;
+
+ # cache ?
+ # acces to data by rpm2 should be fast,
+ # so do not need cache
+ # and init_cache works with a command to exec
+ # not with a perl module
+
+ display_status('read rpm data using URPM');
+ import URPM;
+ my $db = URPM::DB::open();
+ debug('1 : analysis');
+
+ my $flag_suggests = is_set( $rh_opt, 'suggests' );
+
+ my %objects;
+ $db->traverse(
+ sub {
+ my ($package) = @_; # this is a URPM::Package object
+ my $name = $package->name;
+ my $installtime = $package->queryformat('%{INSTALLTIME}');
+ $rh_install_time->{$name} = $installtime;
+ my @req = $package->requires();
+ clean_rel( \@req );
+ my @prov = $package->provides();
+ clean_rel( \@prov );
+ my @files = $package->files();
+
+ if ($flag_suggests) {
+ my $suggests = $package->queryformat('[%{SUGGESTS},]');
+ my @suggests = split /,/, $suggests;
+
+ #debug("suggests for $name : " . join ' ', @suggests);
+ clean_rel( \@suggests );
+ push @req, @suggests;
+ }
+
+ analyse_rpm_info(
+ $name, \@prov, \@req, \@files,
+ \%objects, $rh_provides, $rh_files, $rh_depends,
+ $rh_virtual, $rh_requires
+ );
+ }
+ );
+
+ return;
+}
+#########################################################
+sub read_rpm_data($$$$$$$) {
+ my $rh_opt = shift @_; # hash of program arguments
+ my $rh_provides = shift @_;
+ my $rh_install_time = shift @_;
+ my $rh_files = shift @_;
+ my $rh_depends = shift @_;
+ my $rh_virtual = shift @_;
+ my $rh_requires = shift @_;
+
+ # empty all structures
+ %{$rh_provides} = ();
+ %{$rh_install_time} = ();
+ %{$rh_files} = ();
+ %{$rh_depends} = ();
+ %{$rh_virtual} = ();
+ %{$rh_requires} = ();
+
+ my %code = (
+ 'URPM' => \&read_rpm_data_urpm,
+ 'RPM2' => \&read_rpm_data_rpm2,
+ 'basic' => \&read_rpm_data_base,
+ );
+ my @def_list = ( 'URPM', 'RPM2', 'basic' );
+ my @list;
+ if ( exists $ENV{'RPMORPHAN_METHOD'} ) {
+ my $method = $ENV{'RPMORPHAN_METHOD'};
+
+ # should be 'URPM', 'RPM2' or 'basic'
+ if ( exists $code{$method} ) {
+ push @list, $method;
+
+ # for security : basic will allways work
+ push @list, 'basic';
+ }
+ else {
+ warning("unknown method $method, use default");
+ @list = @def_list;
+ }
+ }
+ else {
+
+ # default list (ordered) of perl packages to test
+ @list = @def_list;
+ }
+ my $ok = 0;
+ foreach my $method (@list) {
+ debug("try $method");
+ eval { require $method . '.pm'; };
+ if ($EVAL_ERROR) {
+ debug("can not use $method");
+ }
+ else {
+ $ok = 1;
+ *read_rpm_data_m = $code{$method};
+ read_rpm_data_m( $rh_opt, $rh_provides, $rh_install_time, $rh_files,
+ $rh_depends, $rh_virtual, $rh_requires );
+ last;
+ }
+ }
+ if ( !$ok ) {
+
+ # if nothing is working, use default basic method
+ read_rpm_data_base( $rh_opt, $rh_provides, $rh_install_time, $rh_files,
+ $rh_depends, $rh_virtual, $rh_requires );
+ }
+ return;
+}
+## use critic
+#########################################################
+sub read_one_rc($$$) {
+ my $rh_list = shift @_; # list of available parameters
+ my $fh_rc = shift @_;
+ my $rcfile = shift @_;
+
+ # perl cookbook, 8.16
+ my $line = 1;
+ RC: while (<$fh_rc>) {
+ chomp;
+ s/#.*//; # comments
+ s/^\s+//; # skip spaces
+ s/\s+$//;
+ next RC unless length;
+ my ( $key, $value ) = split /\s*=\s*/, $_, 2;
+ if ( defined $key ) {
+ if ( exists $rh_list->{$key} ) {
+
+ # the last line wins
+ if ( ref( $rh_list->{$key} ) eq 'ARRAY' ) {
+ @{ $rh_list->{$key} } = get_from_command_line($value);
+ }
+ else {
+ ${ $rh_list->{$key} } = $value;
+ }
+
+ # special case : verbose will modify immediately behavior
+ init_debug($value) if ( $key eq 'verbose' );
+
+ debug(
+"rcfile ($rcfile) : found $key parameter with value : $value"
+ );
+ }
+ else {
+ warning("bad $key parameter in line $line in $rcfile file");
+ }
+ }
+ else {
+ warning("bad line $line in $rcfile file");
+ }
+ $line++;
+ }
+
+ return;
+}
+#########################################################
+# read all existing rc file from general to local :
+# host, home, local directory
+sub readrc($) {
+
+ my $rh_list = shift @_; # list of available parameters
+
+ # can use local rc file, home rc file, host rc file
+ my @list_rc =
+ ( '/etc/rpmorphanrc', $ENV{HOME} . '/.rpmorphanrc', '.rpmorphanrc', );
+
+ foreach my $rcfile (@list_rc) {
+
+ if ( -f $rcfile ) {
+ debug("read rc from $rcfile");
+ if ( open my $fh_rc, '<', $rcfile ) {
+ read_one_rc( $rh_list, $fh_rc, $rcfile );
+ close $fh_rc
+ or warning("problem to close rc file $rcfile :$ERRNO");
+ }
+ else {
+ warning("can not open rcfile $rcfile : $ERRNO");
+ }
+ }
+ else {
+ debug("no rcfile $rcfile found");
+ }
+ }
+ return;
+}
+#########################################################
+# because arg can be given in one or several options :
+# --add toto1 --add toto2
+# --add toto1,toto2
+sub get_from_command_line(@) {
+ my @arg = @_;
+
+ my $comma = q{,};
+ ## no critic (ProhibitParensWithBuiltins);
+ return split /$comma/, join( $comma, @arg );
+ ## use critic;
+}
+#########################################################
+sub is_remove_allowed($) {
+ my $opt_dry_run = shift @_;
+
+ return ( ( $EFFECTIVE_USER_ID == 0 ) && ( !$opt_dry_run ) );
+}
+#########################################################
+# analyse command line options for guess
+sub ana_guess($) {
+ my $rh_opt = shift @_;
+
+ debug('ana_guess');
+
+ my $true = 1;
+
+ # guess-all force all others
+ if ( is_set( $rh_opt, 'guess-all' ) ) {
+ $rh_opt->{'guess-perl'} = \$true;
+ $rh_opt->{'guess-python'} = \$true;
+ $rh_opt->{'guess-pike'} = \$true;
+ $rh_opt->{'guess-ruby'} = \$true;
+ $rh_opt->{'guess-common'} = \$true;
+ $rh_opt->{'guess-data'} = \$true;
+ $rh_opt->{'guess-doc'} = \$true;
+ $rh_opt->{'guess-dev'} = \$true;
+ $rh_opt->{'guess-lib'} = \$true;
+ }
+
+ my $is_guess =
+ is_set( $rh_opt, 'guess-perl' )
+ || is_set( $rh_opt, 'guess-python' )
+ || is_set( $rh_opt, 'guess-pike' )
+ || is_set( $rh_opt, 'guess-ruby' )
+ || is_set( $rh_opt, 'guess-common' )
+ || is_set( $rh_opt, 'guess-data' )
+ || is_set( $rh_opt, 'guess-doc' )
+ || is_set( $rh_opt, 'guess-dev' )
+ || is_set( $rh_opt, 'guess-lib' )
+ || is_set( $rh_opt, 'guess-custom' );
+
+ # test if a target is set
+ if ( ( !@{ $rh_opt->{'package'} } )
+ && ( !is_set( $rh_opt, 'all' ) )
+ && ( !$is_guess ) )
+ {
+
+ # default behavior if no targets selected
+ debug('set target to guess-lib (default)');
+ $rh_opt->{'guess-lib'} = \$true;
+ }
+ return;
+}
+#########################################################
+# parse command line exclude option
+sub build_excluded($$) {
+ my $rh_opt = shift @_;
+ my $rh_excluded = shift @_;
+
+ debug('build_excluded');
+ if ( $rh_opt->{'exclude'} ) {
+
+ # allow comma separated options on tags option
+ # and build a hash for faster access
+ my @liste_ex = get_from_command_line( @{ $rh_opt->{'exclude'} } );
+ foreach my $ex (@liste_ex) {
+ $rh_excluded->{$ex} = 1;
+ debug("build_excluded : exclude $ex");
+ }
+ }
+
+ # to be passed to load_data;
+ # be carefull : we use here a new key : excluded , not exclude (command line)
+ $rh_opt->{'excluded'} = $rh_excluded;
+ return;
+}
+#########################################################
+sub get_package_info($) {
+ my $pac = shift @_;
+
+ my $cmd = "rpm -qil $pac";
+ ## no critic ( ProhibitBacktickOperators );
+ my @res = `$cmd`;
+ ## use critic
+ chomp @res;
+
+ return @res;
+}
+#########################################################
+sub get_package_summary($) {
+ my $pac = shift @_;
+
+ my $cmd = "rpm -q --queryformat '%{SUMMARY}' $pac";
+ ## no critic ( ProhibitBacktickOperators );
+ my $res = `$cmd`;
+ ## use critic
+
+ return $res;
+}
+#########################################################
+# return true is rpm allow SUGGEST tags
+sub is_suggests() {
+
+ my $cmd = 'rpm -q --querytags ';
+ ## no critic ( ProhibitBacktickOperators );
+ my @res = `$cmd`;
+ ## use critic
+ foreach my $tag (@res) {
+ chomp $tag;
+ if ( $tag =~ m/^SUGGESTS/ ) {
+ return 1;
+ }
+ }
+ return 0;
+}
+#########################################################
+
+1;