Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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.

So the challenge was to hack directly the fomous file 02packages.details.txt that we receive (gzipped) when we search some module with some CPAN client. I used Term::ReadLine not without some headache.

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 Data::Diver and on my own at an ancient and unmaintained Data::Walker one.

I was not able to bind 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.

Surprisingly it worked.

This is the usage and the navigation commands available during the navigation:
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
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"; }


HtH
L*

update: take a look also at Re: Autocomplete in perl console application
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

In reply to CPAN Namespace Navigator by Discipulus

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2021-06-22 05:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (100 votes). Check out past polls.

    Notices?