# (Please move this node if it belongs in Snippets or something)
#
# This little program will print a prettified inheritance
# tree for the given perl module.  Its usage is:
# perl-inheritance [<options>] <module-name>
# e.g.: perl-inheritance Class::DBI
#
# Available options are:
# -I<path> : include <path> in @INC
# -a : attempt to use all modules instead of just the root one
# -i : ignore modules that can't be found
#
# Some example output:
# perl-inheritance Class::DBI
# Class::DBI (v0.93)
# +---Class::DBI::__::Base (v-1, set by base.pm)
#     +---Class::Data::Inheritable (v0.02)
#     +---Class::Accessor (v0.18)
#     +---Ima::DBI (v0.29)
#         +---Class::WhiteHole (v0.04)
#         +---DBI (v1.37)
#         |   +---Exporter (v5.567)
#         |   +---DynaLoader (v1.04)
#         +---Class::Data::Inheritable (loaded by Class::DBI::__::Base)
#
# perl-inheritance Net::FTP
# Net::FTP (v2.71)
# +---Exporter (v5.567)
# +---Net::Cmd (v2.24)
# |   +---Exporter (loaded by Net::FTP)
# +---IO::Socket::INET (v1.26)
#     +---IO::Socket (v1.27)
#         +---IO::Handle (v1.21)
#             +---Exporter (loaded by Net::FTP)

#!/usr/local/bin/perl -w
use warnings;
use strict;
no strict 'refs';

my @ignore_list      = ();
my $ignore_not_found = 0;
my %already_loaded   = ();
my $load_all         = 0;

ARG: while (@ARGV) {
  SWITCH: {
    ($ARGV[0] =~ /\-I(.+)/o) && do {
      eval "use lib '$1';";
      shift @ARGV;
     last SWITCH;
    };
    ($ARGV[0] =~ /\-i$/o) && do {
      $ignore_not_found = 1;
      shift @ARGV;
     last SWITCH;
    };
    ($ARGV[0] =~ /\-a$/o) && do {
      $load_all = 1;
      shift @ARGV;
     last SWITCH;
    };
    ($ARGV[0] =~ /\-i=(.+)/o) && do {
      @ignore_list = split " ", $1;
      shift @ARGV;
     last SWITCH;
    };
   last ARG;
  } ## end SWITCH:
} ## end while (@ARGV)

if (!@ARGV) {
  print STDERR "Usage: $0 <perl modules>\n";
  exit 1;
}

foreach (@ARGV) {
  %already_loaded = ();
  ScanModule(undef, $_, 0);
}

sub ScanModule {
  my $parent  = shift;
  my $module  = shift;
  my $depth   = shift;
  my @total   = @_;
  my $ignored = 0;
  my $loaded  = 0;

  $loaded = 1 if (exists $already_loaded{$module});

  eval "use $module" if (!defined $parent || $load_all);
  if ($@ =~ /Can't locate .+ in \@INC/o) {
    if ($ignore_not_found
      || index("@ignore_list ", "$module ") != -1) {
      $ignored = 1;
      } else {
      die "Error using $module: $@\n";
    }
  } elsif ($@) {
    die "Error using $module: $@\n";
  }

  if ($depth > 1) {
    for (my $iter = 0; $iter < @total - 2; $iter += 2) {
      if ($total[$iter] < $total[$iter + 1]) {
        print "|   ";
      } else {
        print "    ";
      }
    } ## end for (my $iter = 0; $iter...
  } ## end if ($depth > 1)

  if ($depth > 0) {
    print "+---";
  }

  print $module;
  print " (ignored)" if ($ignored);
  if ($loaded) {
    print " (loaded by $already_loaded{$module})\n";
  } else {
    my $version = $module->VERSION();
    print " (v$version)" if $version;
    print "\n";
    my $isa   = "${module}::ISA";
    my $count = 1;
    my $total = @$isa;

    foreach (@$isa) {
      ScanModule($module, $_, $depth + 1, @total, $count, $total);
      $count++;
    }
    $already_loaded{$module} = $parent;
  } ## end else [ if ($loaded)
} ## end sub ScanModule