rebuildperl: Fix a typo

[Fedora-Rebuild.git] / bin / comparebuildroots

#!/usr/bin/perl
use strict;
use warnings;

use Proc::SyncExec;
use Fedora::Rebuild::Package::StateLock;
use RPM::VersionCompare;
use Fedora::Rebuild::Scheduler;
use Carp;

sub usage {
    print<<EOM;
Usage: comparebuildroots THREADS OLD_TAG NEW_TAG [LIST]

Loads list of source package base names from file LIST or standard input,
queries koji for latest builds with OLD_TAG and NEW_TAG, compares their
versions and reports differences. The query will run in parallel
number of THREADS.

Output format is a package per line. First column is package name, second
column is version from OLD_TAG, and third column is version from NEW_TAG.
Columns are separated by tabulator. If a package is missing in given tag,
empty string is printed.

Package name is preceeded by a character signaling difference between tags.
A space stands for equaled builds, plus for newer build in NEW_TAG, minus for
newer build in OLD_TAG.

If an error occures, the script exits immediately with non-zero return code.
EOM
}

# Print message to error output
sub log_error {
    print STDERR @_;
}


# Run command while appending stderr and stdout to log and stdout to refered
# output argument. In case of empty command output fill empty string;
# Blocks. If workdir is nonempty string, switch into it befere execution
# (and opening the log).
# Return true if command succeeds.
sub dooutput {
    my ($output, @command) = @_;

    my ($parent, $child);
    if (!pipe $child, $parent) {
        log_error("Could not get connected pipes for command " .
            Fedora::Rebuild::Package::StateLock::format_command(@command) .
            ": $!\n");
        return 0;
    }

    my $redirect = sub {
        close $child and
        open(STDOUT, '>&', fileno $parent) and
        close $parent and

        return 1;
    };
    my $pid = Proc::SyncExec::sync_exec($redirect, @command);
    {
        my $errno = $!;
        close $parent;
        $! = $errno;
    }
    if (!defined $pid) {
        log_error("Could not execute " .
            Fedora::Rebuild::Package::StateLock::format_command(@command) .
            ": $!\n");
        return 0;
    }

    for ($$output = ''; local $_ = <$child>;) {
        $$output .= $_;
    }

    if ($pid != waitpid($pid, 0) || $?) {
        log_error("Command " .
            Fedora::Rebuild::Package::StateLock::format_command(@command) .
            " failed: " .
            Fedora::Rebuild::Package::StateLock::child_error_as_string . "\n");
        return 0;
    }

    return 1;
}


# Get latest build in a tag as version-release string.
# Return build string in case of succes, empty string if package has not yet
# been built, undef in case of errror;
sub get_latest_build {
    my ($tag, $package) = @_;
    my $build = '';
    if (!dooutput(\$build, 'koji', 'latest-pkg', '--quiet', $tag, $package)) {
        return undef;
    }

    if (!defined $build || $build eq '') {
        return '';
    }

    # Get first word
    if (! ($build =~ /^([\S]+)/)) {
        return undef;
    }
    $build = $1;

    # Remove package base name
    if (! ($build =~ /^.*-([^-]+-[^-]+)$/)) {
        return undef;
    }

    return $1;
}


# Compare version-release string of new and old build.
# Returns 0 if equaled, 1 if $new is bigger, -1 if $new od older, undef in
# case of error.
sub compare {
    my ($new, $old) = @_;

    if ($new eq '') {
        if ($old eq '') {
            return 0;
        }
        return -1;
    }
        
    if ($old eq '') {
        return 1;
    }

    return RPM::VersionCompare::labelCompare($new, $old);
}

# Compare a package in the buildroots
sub compare_package {
    my ($package, $old_tag, $new_tag) = @_;

    my $old_build = get_latest_build($old_tag, $package);
    my $new_build = get_latest_build($new_tag, $package);

    if (!defined $old_build || !defined $new_build) {
        log_error("Could not retrieve latest builds of `" . $package . "'.\n");
        exit 1;
    }

    my $order = compare($new_build, $old_build);
    if (!defined $order) {
        log_error("Could not compare `" . $old_build. "' and `" .
            $new_build . "'.\n");
        exit 1;
    }

    my $diff = ' ';
    if ($order < 0) {
        $diff = '-';
    } elsif ($order > 0) {
        $diff = '+';
    }
    print $diff . "$package\t$old_build\t$new_build\n";

    return 1;
}

# Parse arguments
if ($#ARGV < 2) {
    usage();
    exit 1;
}
my $threads = shift @ARGV;
my $old_tag = shift @ARGV;
my $new_tag = shift @ARGV;
my @packages;


# Load list of packages
while (<>) {
    chomp;
    push @packages, $_;
}


# Check each package
my $scheduler = Fedora::Rebuild::Scheduler->new(
    limit => $threads,
    #name => 'Comparing build roots',
    #total => $#packages
);
my %jobs= ();
my $i = 0;

foreach my $package (@packages) {
    my $job = $scheduler->schedule(\&compare_package, $package,
        $old_tag, $new_tag);
    if (! defined $job) { next; }
    $jobs{$job} = $package;
    my %finished = $scheduler->finish(++$i < @packages);

    while (my ($job, $status) = each %finished) {
        my $package = $jobs{$job};
        if (!$$status[0]) {
            log_error "Could check `" . $package->name . "' package.\n";
            log_error "Waiting for finishing scheduled jobs...\n";
            $scheduler->finish(1);
            log_error "All jobs have finished.\n";
            croak "Could check all packages.\n";
        }
    }
}

exit 0;