#!/usr/pkg/bin/perl
#
# A ldd-replacement which clearly indicates which libraries are needed 
# by which object.
#

my %map;
my %needed_by;
my @todo;

sub do_one_file {
    my $file = shift;
    my @needed;
    my @path;

    open OBJDUMP, "objdump -x $file |";

    while (<OBJDUMP>) {
	chomp;
	if (/NEEDED/) {
	    s/\s*NEEDED\s*//;
	    push @needed, $_;
	}

	if (/RPATH/) {
	    s/\s*RPATH\s*//;
	    @path = split /:/;
	    print "path = @path\n";
	    break;
	}
    }
    close OBJDUMP;

    push @path, "/usr/lib";
    push @path, "/lib";

    print "$file needs:\n";

    for my $lib (@needed) {
	# Find $lib in @path
	my $found = 0;
	PATH:
	for my $dir (@path) {
	    my $candidate = $dir."/".$lib;

	    if (-e $candidate) {
		print "\t$lib => $candidate\n";
		$found = 1;
		if (exists $map{$lib}) {
		    # $candidate was already processed before
		} else {
		    push @todo, $candidate;
		    $map{$lib} = $candidate;
		}
		if (!exists $needed_by{$candidate}) {
		    $needed_by{$candidate} = undef;
		    # then the next push will use autovivivication
		}
		push @{$needed_by{$candidate}}, $file;
		last PATH;
	    }
	}
	if (!$found) {
	    print "\t$lib not found\n";
	}
    }

    if (@needed == 0) {
	print "\t(nothing)\n";
    }

    print "\n";
}

push @todo, @ARGV;

while (@todo) {
    do_one_file(pop @todo);
}

# Dump reverse requirements:

my %fullib;

for my $lib (sort keys %needed_by) {
    print "$lib <=\n";
    for my $by (@{$needed_by{$lib}}) {
	print "\t$by\n";
    }
    print "\n";

    # Create a mapping of short lib name to full file name
    # to detect potential conflicts
    my $short = $lib;
    $short =~ s=.*/==;
    $short =~ s=\.so[.0-9]*==;
    if (!exists $fullib{$short}) {
	$fullib{$short} = undef;
	# then the next push will use autovivivication
    }
    push @{$fullib{$short}}, $lib;
}

# Dump conflicts

print "Conflicting libraries:\n";

for my $lib (sort keys %fullib) {
    my @longnames = @{$fullib{$lib}};
    if (@longnames > 1) {
	print "$lib ==\n";
	for my $longname (@longnames) {
	    print "\t", $longname, "\n";
	    for my $by (@{$needed_by{$longname}}) {
		print "\t\t$by\n";
	    }
	    print "\n";
	}
    }
}