mirror of
https://pagure.io/fedora-qa/os-autoinst-distri-fedora.git
synced 2024-11-21 21:43:08 +00:00
212 lines
6.4 KiB
Perl
212 lines
6.4 KiB
Perl
|
package dnf;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use base 'Exporter';
|
||
|
use Exporter;
|
||
|
use lockapi;
|
||
|
use testapi;
|
||
|
use utils;
|
||
|
|
||
|
our @EXPORT = qw(install check remove reinstall parse_list_output parse_history_info latest_item parse_info parse_package_name confirm_in_lines confirm_in_output);
|
||
|
|
||
|
|
||
|
# This subroutine install a $package using DNF5.
|
||
|
# It dies if the command returns a non-zero exit
|
||
|
# code or if it times out.
|
||
|
sub install {
|
||
|
my $package = shift;
|
||
|
assert_script_run("dnf5 install -y $package", timeout => 120);
|
||
|
}
|
||
|
|
||
|
# This subroutine checks if the $package is installed
|
||
|
# using the rpm command. It returns True if it is
|
||
|
# installed.
|
||
|
sub check {
|
||
|
my $package = shift;
|
||
|
if (script_run("rpm -q $package", timeout => 60)) {
|
||
|
return 0;
|
||
|
}
|
||
|
else {
|
||
|
return 1;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# This subroutine removes the package using DNF5.
|
||
|
sub remove {
|
||
|
my $package = shift;
|
||
|
assert_script_run("dnf5 remove -y $package", timeout => 120);
|
||
|
}
|
||
|
|
||
|
# This subroutine reinstalls the package using DNF5.
|
||
|
sub reinstall {
|
||
|
my $package = shift;
|
||
|
assert_script_run("dnf5 reinstall -y $package", timeout => 120);
|
||
|
}
|
||
|
|
||
|
# This subroutine will parse the DNF5 cli output
|
||
|
# and return a hash with activities.
|
||
|
# Parsing the output is quite fragile, because
|
||
|
# the info is only divided by whitespaces and some
|
||
|
# columns are empty, so we retain column information
|
||
|
# in this case. Therefore, we will only consider
|
||
|
# the following structure, that will do for simple
|
||
|
# transactions:
|
||
|
# number : dnf5 : command : value : date
|
||
|
sub parse_list_output {
|
||
|
my $dnf = shift;
|
||
|
# Let us split the whole ouput into single lines
|
||
|
my @lines = split("\n", $dnf);
|
||
|
# The final hash with output information.
|
||
|
my $parsed_output = {};
|
||
|
# Let's iterate over the single lines and split
|
||
|
# them into single columns and store in the
|
||
|
# parsed output.
|
||
|
my $values = [];
|
||
|
for my $line (@lines) {
|
||
|
# Split columns on a white space.
|
||
|
my @columns = split(" ", $line);
|
||
|
# Take the columns
|
||
|
$values->[0] = $columns[1];
|
||
|
$values->[1] = $columns[2];
|
||
|
# When date comes on the third place, it means
|
||
|
# that the command did not have any arguments.
|
||
|
# We need to remember this and we will store
|
||
|
# an empty string instead.
|
||
|
if ($columns[3] =~ /\d\d\d\d-\d\d-\d\d/) {
|
||
|
$values->[2] = "";
|
||
|
$values->[3] = $columns[3];
|
||
|
}
|
||
|
# All DNF commands have the "-y" argument
|
||
|
# which we also need to think about.
|
||
|
elsif ($columns[3] eq "-y") {
|
||
|
$values->[2] = $columns[4];
|
||
|
$values->[3] = $columns[5];
|
||
|
}
|
||
|
else {
|
||
|
$values->[2] = $columns[3];
|
||
|
$values->[3] = $columns[4];
|
||
|
}
|
||
|
# The output also contains a description line that
|
||
|
# we do not want to store. That line leaves the "ID"
|
||
|
# string in the first place, so it is easy to find.
|
||
|
unless ($columns[0] eq "ID") {
|
||
|
$parsed_output->{$columns[0]} = $values;
|
||
|
}
|
||
|
}
|
||
|
return $parsed_output;
|
||
|
}
|
||
|
|
||
|
# This subroutine parses the DNF5 history info output. We will
|
||
|
# only consider several fields in order not to make things overly
|
||
|
# complicated, i.e. ID, user, status, releasever, and description.
|
||
|
sub parse_history_info {
|
||
|
my $dnf = shift;
|
||
|
# First, split into single lines.
|
||
|
my @lines = split("\n", $dnf);
|
||
|
# The final hash with output info
|
||
|
my $parsed_output = {};
|
||
|
# These are columns we are interested in.
|
||
|
my $selected = ["Transaction ID", "User", "Status", "Releasever", "Description"];
|
||
|
# Let us iterate over the lines and only choose info we want
|
||
|
for my $line (@lines) {
|
||
|
my @columns = split(" : ", $line);
|
||
|
# Trim the whitespaces from the column name
|
||
|
my $name = $columns[0];
|
||
|
$name =~ s/^\s+|\s+$//g;
|
||
|
# Only remember lines where $name matches
|
||
|
if ($name ~~ @$selected) {
|
||
|
$parsed_output->{$name} = $columns[1];
|
||
|
}
|
||
|
}
|
||
|
return $parsed_output;
|
||
|
}
|
||
|
|
||
|
# This subroutine returns the id number of the latest history item,
|
||
|
# based on the parsed history output, see parse_list_output.
|
||
|
sub latest_item {
|
||
|
# It takes the parsed data already.
|
||
|
my $dnfdata = shift;
|
||
|
# Take the keys list of ID numbers.
|
||
|
my @ids = keys %$dnfdata;
|
||
|
# Sort the keys as keys might not be sorted.
|
||
|
@ids = sort { $b <=> $a } @ids;
|
||
|
# The latest item, with highest number will now be at index 0.
|
||
|
return $ids[0];
|
||
|
}
|
||
|
|
||
|
# This subroutine parses info from the 'info' output
|
||
|
# and returns a hash where the output comprises
|
||
|
# of keys and values.
|
||
|
sub parse_info {
|
||
|
my $output = shift;
|
||
|
my $info = {};
|
||
|
|
||
|
my @output = split("\n", $output);
|
||
|
foreach (@output) {
|
||
|
my ($key, $value) = split(" : ", $_);
|
||
|
$key =~ s/^\s+|\s+$//g;
|
||
|
$value =~ s/^\s+|\s+$//g;
|
||
|
$info->{$key} = $value;
|
||
|
}
|
||
|
return $info;
|
||
|
}
|
||
|
|
||
|
# This routine takes the package name
|
||
|
# and splits it into various parts that are
|
||
|
# returned as a hash where the values are
|
||
|
# easily accessible.
|
||
|
sub parse_package_name {
|
||
|
my $rpm = shift;
|
||
|
my @rpm = split("-", $rpm);
|
||
|
my ($name, $version, $suffix) = split("-", $rpm);
|
||
|
my ($release, $os, $arch);
|
||
|
($release, $os, $arch, $suffix) = split(/\./, $suffix);
|
||
|
my $package = {};
|
||
|
$package->{name} = $name;
|
||
|
$package->{version} = $version;
|
||
|
$package->{release} = "$release.$os";
|
||
|
$package->{arch} = $arch;
|
||
|
return $package;
|
||
|
}
|
||
|
|
||
|
|
||
|
# This subroutine checks all the lines of $output
|
||
|
# for the $keyword and records all lines where
|
||
|
# the $keyword is not found and then it dies.
|
||
|
sub confirm_in_lines {
|
||
|
my ($output, $keyword) = @_;
|
||
|
my @unmatched;
|
||
|
my @lines = split("\n", $output);
|
||
|
# Iterate over the lines and record any line with a discrepancy
|
||
|
# into the unmatched array.
|
||
|
foreach (@lines) {
|
||
|
unless ($_ =~ /Updating and loading/ or $_ =~ /Repositories loaded/) {
|
||
|
unless ($_ =~ /$keyword/) {
|
||
|
push(@unmatched, $_);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
# If there are errors in unmatched, log them and die.
|
||
|
if (scalar(@unmatched) > 0) {
|
||
|
diag("DNF5 Repoquerry errors:");
|
||
|
foreach (@unmatched) {
|
||
|
diag($_);
|
||
|
}
|
||
|
die("dnf5 repoquery returned lines that did not match the chosen pattern.");
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# This subroutine checks that the $keyword
|
||
|
# exists in the $output and dies if it does not.
|
||
|
sub confirm_in_output {
|
||
|
my ($output, $keywords) = @_;
|
||
|
my @lines = split("\n", $output);
|
||
|
foreach (@$keywords) {
|
||
|
unless (grep(/$_/, @lines)) {
|
||
|
die("The $_ was not found in the output.");
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|