Blob Blame History Raw
#!/usr/bin/perl
use strict;
use warnings;

# Split "A B >= 1" dependencies string into ("A", "B >= 1") list.
sub appendsymbols {
    my ($array, $line) = @_;
    my $qualified;
    my $dependency;
    for my $token (split(/\s/, $line)) {
        if ($token =~ /\A[<>]?=\z/) {
            $qualified = 1;
            $dependency .= ' ' . $token;
            next;
        }
        if (!$qualified) {
            if (defined $dependency) {
                push @$array, $dependency;
            }
            $dependency = $token;
            next;
        }
        if ($qualified) {
            $qualified = 0;
            $dependency .= ' ' . $token;
            push @$array, $dependency;
            $dependency = undef;
            next;
        }
    }
    if (defined $dependency) {
        push @$array, $dependency;
    }
}

# Return true if the argument is a Perl dependency. Otherwise return false.
sub is_perl_dependency {
    my $dependency = shift;
    return ($dependency =~ /\Aperl\(/);
}

my $file = shift @ARGV;
if (!defined $file) {
	die "Missing an argument with an RPM build log!\n"
}

# Parse build log
open(my $log, '<', $file) or die "Could not open `$file': $!\n";
my ($package, %packages);
while (!eof($log)) {
    defined($_ = <$log>) or die "Error while reading from `$file': $!\n";
	chomp;

	if (/\AProcessing files: ([\S]+)-[^-]+-[^-]+$/) {
		$package = $1;
        $packages{$package}{requires} = [];
        $packages{$package}{provides} = [];
	} elsif ($package && /\AProvides: (.*)\z/) {
		appendsymbols($packages{$package}{provides}, $1);
	} elsif ($package && /\ARequires: (.*)\z/) {
		appendsymbols($packages{$package}{requires}, $1);
	}
}
close($log);

# Save dependencies into file
my $filename = 'gendep.macros';
open (my $gendep, '>', $filename) or
    die "Could not open `$filename' for writing: $!\n";
for my $package (sort keys %packages) {
    # Macro name
    my $macro = 'gendep_' . $package;
    $macro =~ s/[+-]/_/g;
    $gendep->print("%global $macro \\\n");
    # Macro value
    for my $dependency (@{$packages{$package}{requires}}) {
        if (is_perl_dependency($dependency)) {
            $gendep->print("Requires: $dependency \\\n");
        }
    }
    for my $dependency (@{$packages{$package}{provides}}) {
        if (is_perl_dependency($dependency)) {
            $gendep->print("Provides: $dependency \\\n");
        }
    }
    # Macro trailer
    $gendep->print("%{nil}\n");
}
close($gendep) or die "Could not close `$filename': $!\n";


__END__
=encoding utf8

=head1 NAME

generatedependencies - Distil generated Perl dependencies from a build log

=head1 SYNOPSIS

B<generatedependencies> I<BUILD_LOG>

=head1 DESCRIPTION

It opens specified RPM build log I<BUILD_LOG>. It locates a protocol about
autogenerated dependencies. It stores the reported dependencies into F<./gendep.macros> file.

The output file will define macros C<gendep_I<BINARY_PACKAGE_NAME>>. A macro
for each binary package. The macro name will use underscores instead of
hyphens or other SPEC language special characters.

It will ignore non-Perl dependencies (not C<perl(*)>) as they do not come from
Perl dependency generator.

=head1 EXIT CODE

Returns zero, if no error occurred. Otherwise non-zero code is returned.

=head1 EXAMPLE

The invocation is:

    $ generatedependencies .build-5.24.0-364.fc25.log

The output is:

    $ grep -A5 perl_Devel_Peek gendep.macros
    %global gendep_perl_Devel_Peek \
    Requires: perl(Exporter) \
    Requires: perl(XSLoader) \
    Provides: perl(Devel::Peek) = 1.23 \
    %nil{}
    %global gendep_perl_Devel_SelfStubber \


The output can be used in a spec file like:

    Name: perl
    Source0: gendep.macros
    %include %{SOURCE0}
    %package Devel-Peek
    %gendep_Devel_Peek
    %package Devel-SelfStubber
    %gendep_Devel_SelfStubber

=head1 COPYING

Copyright (C) 2016  Petr Písař <ppisar@redhat.com>

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 3 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.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut