#!/usr/local/bin/perl -w

use strict;
use Data::Dumper;
use IO::Zlib;

=head1 NAME

cpantree - print out a tree of cpan module heirachy

=head1 USAGE

    cpantree

or with an optional root 

    cpantree Module::Pluggable

=head1 AUTHOR

Simon Wistow based on code by brain d. foy

http://use.perl.org/comments.pl?sid=32110&cid=48614

=cut


# get an optional pattern to match
my $pattern = shift; $pattern =~ s!::$!! if defined $pattern;

# geta  file handle to read
my $fh = get_package_fh(); 
while ( <$fh> ) { last if /^\s*$/ } # goodbye header
 
my @last_names;
while ( <$fh> ) {
    my $bit   = (split)[0];
    # skip if we have a pattern and it doesn't match
    next if defined $pattern && $bit !~ m!^$pattern(::|$)!;
    my @names = split /::/, $bit;

    # remove parts in common with previous module 
    my $common = 0; 
    foreach my $i ( 0 .. $#last_names ) {
        last unless $last_names[$i] eq $names[$i];
        $common++;
    }
 
    foreach my $j ( $common  .. $#names ) {
        print "\t" x $common++, "- $names[$j]\n";
    }
 
    @last_names = @names;
}



sub get_package_fh {
    # get where the local modulelist is from CPAN(PLUS?)::Config
    my $base;
    eval { require CPANPLUS::Config; import CPANPLUS::Config; };    
    unless ($@) {
        my $conf = CPANPLUS::Config->new();
        # different versions have the config in different places
        for (qw(conf _build)) {
            $base = $conf->{$_}->{base}   if exists $conf->{$_};
        }
    }

    goto SKIP if defined $base;

    eval { require CPAN::Config; import CPAN::Config };
    unless ($@) {
        if ($CPAN::Config->{'keep_source_where'}) {
            $base = $CPAN::Config->{'keep_source_where'}."/modules/";
        }
    }

    goto SKIP if defined $base;

    die "Couldn't find where you keep your CPAN Modlist\n";

    SKIP:

    my $file = "${base}/02packages.details.txt.gz";

    # open the file and feed it to the mod list parser
    my $fh = IO::Zlib->new($file, "rb")  or die "Cannot open $file\n";

    return $fh;
}