CUFP
Discipulus
CPAN Namespace Navigator is an interactive program that let you to navigate all namespaces on CPAN.<BR>
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.<BR><BR>
So the challenge was to hack directly the fomous file [href://www.cpan.org/modules/02packages.details.txt|02packages.details.txt] that we receive (gzipped) when we search some module with some CPAN client. I used [mod://Term::ReadLine] not without some [id://1108255|headache].<BR><BR>
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 [ambrus] and [yitzchak] i looked at [tye]'s [https://metacpan.org/pod/Data::Diver|Data::Diver] and on my own at an ancient and unmaintained [href://http://search.cpan.org/~jnolan/Data-Walker-1.05/Data/Walker.pm|Data::Walker] one.<BR><BR>
I was not able to bind [https://metacpan.org/pod/Data::Diver|Data::Diver] at my will to add to the structure others infos like parent namespace or version, so i reinvented that wheel evaluating everything by myself.<BR><BR>
Surprisingly it worked. <BR><BR>
This is the usage and the navigation commands available during the navigation:
<CODE>
USAGE: cpannn.pl [02packages.details.txt]
NAVIGATION:
. simple list of contained namespaces
.. move one level up
+ detailed list of contained namespaces
* read the readme file of current namespace
** download the current namespace's package
? print this help
TAB completion enabled on all sub namespaces
cpannn.pl by Discipulus as found at perlmonks.org
</CODE>
And here you have the code, finally crafted after 37 steps of development.<BR><BR>
<p>
<readmore>
<c>
#!perl
use strict;
use warnings; # CPANnn would be impossible without a big ABuse of Data::Dump::Streamer
my ($ua,$cpanfh); # ugly again? no! UserAgent. need to be here before 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 possible 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::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";
}
use Term::ReadLine;
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
}
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
# 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_line," for $url\n";next;}
foreach my $line (split "\n",$resp->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); }
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";
}
</c>
</readmore>
</p>
<BR>HtH<BR>L*<BR><BR>
update: take a look also at [id://630047]
<div class="pmsig"><div class="pmsig-174111">
There are no rules, there are no thumbs..<BR>
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
</div></div>