CPAN Namespace Navigator is an interactive program that let you to navigate all namespaces on CPAN.
The idea born when i read that before upload something to CPAN is better to explore existing modules, but when i asked here in the chat how to browse it i discovered that ther is not a real exploration program to do it.
that we receive (gzipped) when we search some module with some CPAN client. I used
.
I decided (unwisely) to eval directly the data received to build up a big HoH with the whole hierarchy of CPAN modules and reletad infos.
As suggested (wisely) by
one.
at my will to add to the structure others infos like parent namespace or version, so i reinvented that wheel evaluating everything by myself.
Surprisingly it worked.
This is the usage and the navigation commands available during the navigation:
And here you have the code, finally crafted after 37 steps of development.
#!perl
use strict;
use warnings; # CPANnn would be impossible without a big ABuse o
+f Data::Dump::Streamer
my ($ua,$cpanfh); # ugly again? no! UserAgent. need to be here befor
+e BEGIN block,the file handle for cpan data too
BEGIN{
local $@;
$ENV{PERL_RL}="Perl";
$ENV{TERM} = 'not dumb' if $^O eq 'MSWin32';# TAB completion made po
+ssible on win32 via Term::Readline with TERM=
eval{ require LWP::UserAgent; };
if ($@){print "WARNING: no LWP::UserAgent support!"}
if ($@ and !$ARGV[0]){die "FATAL: no filename as argument nor LWP::U
+serAgent 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";
}
use Term::ReadLine;
my $term = Term::ReadLine->new('CPAN namespace navigator');
my $cpan = {'.'=>'CPAN'}; # the main cpan hasref, container of a
+ll 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 re
+adme files
my @infos = "\nINFO:\n\n"; # infos about the file and help too
# now feed @infos with headers from fi
+le
while (<$cpanfh>){print "Processing data, please wait..\n" and last if
+ /^$/;push @infos, $_}
push @infos, $_ for "\n\n","USAGE: $0 [02packages.details.txt]\n\nNAVI
+GATION:\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 t
+he current namespace's package\n",
"? print this help\n","\nTAB completion enabled on all sub name
+spaces\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 ele
+ment
eval '$cpan->{\''. # start of cpan containe
+r; it ends before next = sign
(join '\'}{\'', @names).'\'} ='.# expand names and vivif
+ies BECAUSE there is an assignment
'{'. # hasref start
'"."=>$names[-1],'. # hasref . is name and .
+. is a ref to father
'".."=> \%{$cpan'.(defined $ancestors[0] ?'->{\''.(j
+oin '\'}{\'', @ancestors ).'\'}':'').'},'.
'"+"=> [$fields[1],$fields[2]],'. # hashref + is use
+d for version and author path array
'}; '; # hashref end
}
my $current = \%$cpan; # the current hashref namespace starts at top l
+evel 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
# the line below is the first time initalization for autocompletion
$term->Attribs->{completion_function} = sub {my $txt=shift;return grep
+ { /^$txt/i } grep $_ !~ $skiprx,sort keys %$current};
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 ..
pop @cur_names;
$current = \%{ eval '$cpan->{\''.(join '\'}{\'', @cur_names).
+'\'}' || $cpan } ;
}
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;
my $resp = $ua->get($url);
if ($resp->is_error){print "WARNING: ",$resp->status_l
+ine," for $url\n";next;}
foreach my $line (split "\n",$resp->content()) {
++$line_count;
print "$line_count:".$line."\n" ;
if ($line_count % $pagination == 0){print "-- pres
+s 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/'.$$curr
+ent{'+'}->[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); }
sub header {
my $hr = shift;
my $num = scalar@{[grep $_ !~ $skiprx, keys %$hr]};
print "\n",(join '::',@cur_names or 'CPAN'),($$hr{'+'}->[0] ? "\t$
+$hr{'+'}->[0]\t$$hr{'+'}->[1]" : "")," contains ",$num," namespace".(
+$num>1?'s':'')."\n\n";
}