#!perl
use strict;
use warnings;       use Data::Dump::Streamer;
use Term::ReadLine; # CPANnn would be impossible without a big ABuse of Data::Dump::Streamer
$ENV{TERM}=undef;   # TAB completion made possible on win32 via Term::Readline with TERM=
my ($ua,$cpanfh);   # ugly again? no! UserAgent. need to be here before BEGIN is found,the file handle for cpan data too
BEGIN{
  local $@;
  eval{ require LWP::UserAgent; };
  if ($@){print "WARNING: no LWP::UserAgent support!"}
  if ($@ and !$ARGV[0]){die "FATAL: no filename as argument nor LWP::UserAgent support!\n"}
  $ua = LWP::UserAgent->new;
  my $filename = defined $ARGV[0] ? $ARGV[0] : '02packages.details.txt';  # this must go inside or assignment is not run
  if (!$ARGV[0]){ print "Downloading $filename, please wait..\n";
                  $ua->get('http://www.cpan.org/modules/'.$filename,':content_file'=>$filename) }
  open $cpanfh,'<',$filename or die "FATAL: unable to open '$filename' for reading!\n";
}
my $term = Term::ReadLine->new('CPAN namespace navigator');
my $cpan = {'.'=>'CPAN'};       # the main cpan hasref, container of all namespaces
my $skiprx = qr/^[\.\+]{1,2}$/; # regex used to skip secret hash keys: . .. + ++ (last not used really)
my $pagination = 20;            # used to divide in screenfulls the readme files
my @infos = "\nINFO:\n\n";      # infos about the file and help too
                                # now feed @infos with headers from file
while (<$cpanfh>){print "Processing data, please wait..\n" and last if /^$/;push @infos, $_}
push @infos, $_ for "\n\n","USAGE: $0 [02packages.details.txt]\n\nNAVIGATION:\n\n",
      ".  simple list of contained namespaces\n",".. move one level up\n","+  detailed list of contained namespaces\n",
      "*  read the readme file of current namespace\n", "** download the current namespace's package\n",
      "?  print this help\n","\nTAB completion enabled on all sub namespaces\n","$0 by Discipulus as found at perlmonks.org\n\n";
while (<$cpanfh>){               # main extrapolation loop
        chomp;                   # AA::BB::CC  0.01 D/DI/DISCIPULUS/AA-BB-CC-0.001.tar.gz
        my @fields = split /\s+/;# split namespaces, version, partial path
        my @names = split /::/, $fields[0];# split namespace in AA BB CC
        my @ancestors = @names;
        pop @ancestors;          # @ancestors are @names less last element
        eval '$cpan->{\''.                    # start of cpan container; it ends before next = sign
              (join '\'}{\'', @names).'\'} ='.# expand names and vivifies BECAUSE there is an assignment
               '{'.                           # hasref start
                  '"."=>$names[-1],'.         # hasref . is name and .. is a ref to father
                  '".."=> \%{$cpan'.(defined $ancestors[0] ?'->{\''.(join '\'}{\'',  @ancestors ).'\'}':'').'},'.
                  '"+"=> [$fields[1],$fields[2]],'. # hashref + is used for version and author path array
                '}; ';                        # hashref end
}Dump $cpan;
my $current = \%$cpan; # the current hashref namespace starts at top level of the hash
    &header($current); # first time header
my @cur_names;         # take track of namespaces and, if empty, tell us we are at top level
    &readline::rl_basic_commands(@{&autocompletes}); #first time autocompletes filling

while ( defined ( $_ = $term->readline( (join '::',@cur_names).'>') ) ) {
    /^$/ ? next : chomp;
    s/\s+//g;
    if (exists $$current{$_} and $_ !~ $skiprx) {
        $current = \%{$$current{$_}};
        push @cur_names, $_;
        next;
    }
    elsif($_ eq '.'){ # . -> ls
          print "$_\n" for grep $_ !~ $skiprx, sort keys %$current;
    }
    elsif($_ eq '+'){ # + -> ls -l
          foreach my $k(grep $_ !~ $skiprx, sort keys %$current) {
                  print  "$k\t", ${$current->{$k}{'+'}}[0] ? join "\t", @{$current->{$k}{'+'}} : "--CONTAINER NAMESPACE--","\n";
          }
    }
    elsif($_ eq '..'){# .. -> cd ..
        #$current =  ref $current->{'..'} eq 'HASH' ? \%{$current->{'..'}}: \%$cpan;
        $current =  \%{$current->{'..'}}  ;
        pop @cur_names;
    }
    elsif($_ eq '*'){ # * -> dump the readme
          unless ($ua){print "WARNING: no LWP::UserAgent support!\n"; next;}
          if (defined $$current{'+'}->[0]) {
                (my $url = 'http://www.cpan.org/authors/id/'.$$current{'+'}->[1]) =~s/\.tar\.gz/\.readme/ ;
                my $line_count;
                foreach my $line (split "\n",$ua->get($url)->content()) {
                    ++$line_count;
                    print "$line_count:".$line."\n" ;
                    if ($line_count % $pagination == 0){print "-- press Enter to continue..";while (<STDIN>){last if $_ }}
                }
          }
    }
    elsif($_ eq '**'){# ** -> download the package
          unless ($ua){print "WARNING: no LWP::UserAgent support!\n"; next;}
          if (defined $$current{'+'}->[0]) {
                (my $gzfile = 'http://www.cpan.org/authors/id/'.$$current{'+'}->[1]) =~s{.+/}{} ;
                 my $resp = $ua->get('http://www.cpan.org/authors/id/'.$$current{'+'}->[1],':content_file'=>$gzfile);
                 print $resp->is_success ? "OK: download of '$gzfile' succesfull\n" : "WARNING: $resp->status_line!\n";
          }
    }
    elsif($_ eq '?'){ print for @infos }# * -> shows infos and help
    else{print "WARNING: '$_' command not found!\n"; next}
}
continue{
      &header($current);
      &readline::rl_basic_commands(@{&autocompletes});
}
sub autocompletes{scalar @cur_names > 0 ? return [grep $_ !~ $skiprx,sort keys %$current] : return [grep $_ !~ $skiprx, keys %$cpan]; }
sub header {
    my $hr = shift;
    print "\n",(join '::',@cur_names or 'CPAN'),($$hr{'+'}->[0] ? "\t$$hr{'+'}->[0]\t$$hr{'+'}->[1]" : ""),
          " has ",(scalar@{[grep $_ !~ $skiprx, keys %$hr]})," namespaces\n";
}