#!/usr/bin/env perl
# $Id: rpm-deps,v 1.10 2022/02/20 17:22:56 tom Exp $
# -----------------------------------------------------------------------------
# Copyright 2014,2022 by Thomas E. Dickey
#
#                         All Rights Reserved
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the name(s) of the above copyright
# holders shall not be used in advertising or otherwise to promote the
# sale, use or other dealings in this Software without prior written
# authorization.
# -----------------------------------------------------------------------------
# For a given package, ask the question: what packages satisfy its dependencies,
# and is there a "provides" which can be used as an alias for those.

$| = 1;

use warnings;
use strict;

use Getopt::Std;
use File::Temp qw/ tempfile tempdir /;

use vars qw($opt_d $opt_p $opt_v);

our %defines;

sub what_provides($) {
    my $require = shift;
    $require =~ s/[[:blank:]]+[<>=].*//;
    $require =~ s/\s+$//;
    my $command = sprintf( "rpm -q --whatprovides '%s'", $require );
    my @result;
    my %result;
    printf "# %s\n", $command if ($opt_d);
    if ( open( FP, "$command |" ) ) {
        (@result) = <FP>;
        close(FP);

        for my $n ( 0 .. $#result ) {
            my $key = $result[$n];
            chomp $key;
            printf "\t->%s\n", $key if ($opt_v);
            $result{$key} = $require;
            last;
        }
    }
    return %result;
}

sub get_requirements($) {
    my $package = shift;
    my @result;
    my $p_opts = $opt_p ? "p" : "";
    my %requires;
    my %provides;

    my $command = "rpm -q" . $p_opts . "R $package |";
    printf "# %s\n", $command if ($opt_d);
    if ( open( FP, $command ) ) {
        (@result) = <FP>;
        close(FP);

        for my $n ( 0 .. $#result ) {
            my $key = $result[$n];
            chomp $key;
            next if ( $key =~ /^rpmlib\(/ );
            printf "->%s\n", $key if ($opt_v);
            my %list = &what_provides($key);
            foreach my $subkey ( keys %list ) {
                my %obj;
                if ( $provides{$subkey} ) {
                    %obj = %{ $provides{$subkey} };
                }
                $obj{$key}         = 1;
                $provides{$subkey} = \%obj;
            }
            $requires{$key} = %list;
        }
    }
    foreach my $key ( sort keys %provides ) {
        printf "package %s\n", $key;
        my %obj = %{ $provides{$key} };
        foreach my $subkey ( sort keys %obj ) {
            printf "\t%s\n", $subkey;
        }
    }
    return @result;
}

sub trim_white($) {
    my $line = shift;
    chomp $line;
    $line =~ s/^\s*//;
    $line =~ s/\s*$//;
    return $line;
}

sub params_of($) {
    my $value = shift;
    $value =~ s/^[^[:blank:]]+[[:blank:]]+//;
    return $value;
}

sub do_define($) {
    my $value = shift;
    my $name  = $value;
    $name =~ s/\s.*//;
    $value = &params_of($value);

    # printf "name(%s) = value(%s)\n", $name, $value;
    $defines{$name} = $value;
}

sub do_expand($) {
    my $value = shift;
    while ( $value =~ /%\{/ ) {

        # printf "expand:%s\n", $value;
        my $left = index $value, "%{";
        last if ( $left < 0 );
        my $l_xx = substr $value, 0, $left;

        # printf "%d:%s\n", $left, $l_xx;
        my $r_xx = substr $value, $left;

        # printf "..:%s\n", $r_xx;
        my $right = index $r_xx, "}";
        last if ( $right < 0 );
        my $c_xx = substr $r_xx, 0, $right;
        $r_xx = substr $r_xx, $right + 1;

        # printf "%d'%s'\n", $right, $r_xx;
        $c_xx =~ s/^%\{//;
        $c_xx =~ s/}$//;

        # printf "%d'%s'\n", $right, $c_xx;
        my $x_xx = $defines{$c_xx};

        # printf "->'%s'\n", $x_xx;
        $value = $l_xx . $x_xx . $r_xx;
    }
    return $value;
}

sub do_specfile($) {
    my $specfile = shift;

    if ( open( FP, $specfile ) ) {
        my (@data) = <FP>;
        close FP;
        my $name = "";
        for my $n ( 0 .. $#data ) {
            my $line = &trim_white( $data[$n] );
            if ( $line =~ /^name:/i ) {
                $name = &do_expand( &params_of($line) );
                if ( $name =~ /[[:blank:]$%]/ ) {
                    printf STDERR "cannot parse %s\n", $name;
                    last;
                }
                &do_package($name);
            }
            elsif ( $line =~ /^%package\s/i ) {
                my $package = &do_expand($line);
                $package =~ s/^%package\s+//i;
                if ( $package =~ /^-n\s/ ) {
                    $package =~ s/^-\w+\s+//;
                    &do_package($package);
                }
                else {
                    &do_package( $name . "-" . $package );
                }
            }
            elsif ( $line =~ /^%(define|global)/ ) {
                &do_define( &params_of($line) );
            }
        }
    }
}

sub do_package($) {
    my $package = shift;

    printf "** %s\n", $package;
    if ( $package =~ /\.spec$/ ) {
        &do_specfile($package);
    }
    else {
        my @reqs = &get_requirements($package);
    }
}

sub main::HELP_MESSAGE() {
    printf <<EOF;
Usage: $0 [options] [package1 [package2 [...]]]

Options:
	-d		debug
	-p		analyze package-file
	-v		verbose
EOF
    exit 1;
}

$Getopt::Std::STANDARD_HELP_VERSION = 1;
&getopts('dpv');
$opt_v = 1 if ($opt_d);

if ( $#ARGV >= 0 ) {
    while ( $#ARGV >= 0 ) {
        &do_package( shift @ARGV );
    }
}
else {
    &main::HELP_MESSAGE;
}
