#!/usr/bin/perl -w
#
# Copyright 2007 Cyril Brulebois <cyril.brulebois@enst-bretagne.fr>
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.


use strict;
use List::MoreUtils qw/uniq/;


# Parameter handling

my (@packages) = @ARGV;
die "Usage: $0 pkg1 [... pkgN (space or coma separated)] [level=3]"
    if not @packages;

my $level = $packages[-1];
if ($level =~ /\d+/) {
    pop @packages;
}
else {
    $level = 3;
}


# Entry point

header();
foreach my $package (@packages) {
    $package =~ s/(^\s*|\s*$)//g;
    $package =~ s/,$//;
    hilight($package);
    process("$package", $level);
}
footer();



# Functions

sub header {
    print 'digraph {', "\n";
    print '  rankdir=LR;', "\n";
    print '  node[shape=box];', "\n";
}

sub footer {
    print '}', "\n";
}

sub hilight {
    my $package = shift;
    print "  \"$package\" [color=blue];\n";
}

sub process {
    my $package = shift;
    my $level = shift;
    my (@seen) = @_;
    my @new_seen = ();

    # Do not process it again
    ##print "Package: [$package]\n";
    ##print "Seen: [@seen]\n";
    foreach my $item (@seen) {
        return ()
            if $package eq $item;
    }

    if ($level <= 0) {
        return ();
    }

    # Calculate rdepends
    my ($rpackage, $check, @result)
        = split ("\n", `apt-cache rdepends $package`);

    # Sanity checks
    if ($rpackage ne $package) {
        print "apt-cache rdepends returned: $rpackage\n";
        print "expected: $package\n";
    }
    if ($check ne "Reverse Depends:") {
        print "sanity check failed\n";
    }

    # Actual work
    for (@result) { $_ =~ s/(^\s*|\s*$)//g }
    @result = uniq @result;

    foreach my $dep (@result) {
        if ($dep =~ /^\|/) {
            print "  /* Not considering: $dep */\n";
        }
        else {
            print "  \"$dep\" -> \"$package\" ;\n";
            push @new_seen, process($dep, $level-1, @seen, @new_seen, $package);
        }
    }

    return @new_seen;
}