comment on

new feature added: a tree view of the current namespace:

USAGE: cpannn38.pl [02packages.details.txt | or other valid file]

NAVIGATION:

.  simple list of contained namespaces
.. move one level up
+  detailed list of namespaces directly contained in the current one
++ dump a simple recursive tree of contained namespaces
*  read the readme file of current namespace; needs LWP::UserAgent
** download the current namespace's package; needs LWP::UserAgent
?  print this help

TAB completion, case insensitive, enabled on all sub namespaces
[download]

.. but i need some answer:

Thanks afoken for your crude review.

Is this a joke? If so, I didn't get it.

No was not a joke, was, as always a challenge and the result seems fully usable.

Chaotic indent. 2 spaces, 4, 6, 10, 14, 18, with no obvious rules when and how indenting happens.

Random amount of whitespace around operators

Extra long lines (33% have more than 80 chars) full of commands - Perl ain't MUMPS, stuffing as much code as possible into a single line does not make the code faster.

Here you are completely right. i sanitized cpannn a lot and added, i hope, usefull, comments. the 2 semi ironic comments are removed. humor seems not usefull for every programmer.
You can see CPANnn 2.68 times longer at the end of my answer.

perl 4 function calls with & prefix - my favorite. The last Perl 4 release was about 20 years ago (4.036 released 1993-Feb-05).

About this i have another opinion: the & prefix is still a valid Perl 5 syntax as you can read in official documentation. As i understand & is 'optional' sometimes, and needed other times:

A subroutine may be called using an explicit & prefix. The & is optional in modern Perl, as are parentheses if the subroutine has been predeclared. The & is not optional when just naming the subroutine, such as when it's used as an argument to defined() or undef(). Nor is it optional when you want to do an indirect subroutine call with a subroutine name or reference using the &$subref() or &{$subref}() constructs, although the $subref->() notation solves that problem. See perlref for more about all that.
That said i 'prefer' to use it (because i know what it implies) to visualize my own subs in respect to other functions. If you dont like dont use it, but let me write my Perl 5 code as i prefer.

String evals. Evaluating unverified data read from the network. Twice.

Here you are right somehow: i added a warning at the begin of the program and some blande checks on data received. If you pass a file full of evil strings is not a program's problem. I do not simply like idiot-proof tech. Please let idiots do what they want.

I have many reserves about perlcritc: even if can be used as a guide to write better code, i do not want to code inside such rails. I want to be free while coding Perl. It is my opinion, of course.

I think this is unmaintainable, "write-only code".

Well i just maintained and added a nice feature: a tree dumping of the current package. We can speak of 'Write-Twice-Code' ?

L*

#!perl
use strict;
use warnings;
use Data::Dump::Streamer;
# if you wont to modify CPANnn take in consideration using Data::Dump:
+:Streamer on the $cpan hasref
#
# UserAgent and cpan file handle. need to be here before BEGIN block,t
+he file handle for cpan data too
my ( $ua, $cpanfh );
# BEGIN block needed to set some ENV variables
# and to evaluate LWP::UserAgent support
# Also check some contions and set the file handle $cpanfh
# and, eventually the LWP::UserAgent object $ua
BEGIN {
    # WARNING !! string eval in action!!
    # let people to quit
    print "\n\nWARNING: $0 uses string eval!\n"
        ."Use at your own risk!\nENTER to continue or CTRL-C to termin
+ate.\n";
    while (<STDIN>){last if $_ }
    
    local $@;
    # force Term::ReadLine to load the Term::ReadLine::Perl if present
    $ENV{PERL_RL} = "Perl";
    # TAB completion made possible on win32 via Term::Readline with TE
+RM=
    $ENV{TERM}    = 'not dumb' if $^O eq 'MSWin32';
    # evaluate optional LWP::UserAgent support
    eval { require LWP::UserAgent; };
    if ($@) { print "WARNING: no LWP::UserAgent support!" }
    # die if no LWP::UA nor filename given as arg
    if ( $@ and !$ARGV[0] ) {
        die "FATAL: no filename as argument nor LWP::UserAgent support
+!\n";
    }
    # let's proceed
    $ua = LWP::UserAgent->new;
    # this must go inside BEGIN or assignment is not run
    my $filename =
      defined $ARGV[0]
      ? $ARGV[0]
      : '02packages.details.txt';
    # if we are here we have LWP support
    # so if no filename was given as arg we download it
    if ( !$ARGV[0] ) {
        print "Downloading $filename, please wait..\n";
        $ua->get( 'http://www.cpan.org/modules/' . $filename,
            ':content_file' => $filename );
    }
    # open the file (given or downloaded)
    # and set the filehandle
    open $cpanfh, '<', $filename
      or die "FATAL: unable to open '$filename' for reading!\n";
}
use Term::ReadLine;
my $term = Term::ReadLine->new('CPAN namespace navigator');
# the main cpan hasref, container of all namespaces
my $cpan ={ '.' => 'CPAN' };
# regex used to skip secret hash keys: . .. + ++
my $skiprx = qr/^[\.\+]{1,2}$/;
# used to divide in screenfulls the readme files
my $pagination = 20;
# infos about the file and help too
my @infos      = "\nINFO:\n\n";


# now feed @infos with headers from file 02packages.details.txt
# fetching the cpan file until we reach an empty line
# because after that strat namespaces enumeration
while (<$cpanfh>) {
    print "Processing data, please wait..\n" and last if /^$/;
    push @infos, $_;
}
push @infos, $_
  for "\n\n",
  "USAGE: $0 [02packages.details.txt | or other valid file]\n\nNAVIGAT
+ION:\n\n",
  ".  simple list of contained namespaces\n", ".. move one level up\n"
+,
  "+  detailed list of namespaces directly contained in the current on
+e\n",
  "++ dump a simple recursive tree of contained namespaces\n",
  "*  read the readme file of current namespace; needs LWP::UserAgent\
+n",
  "** download the current namespace's package; needs LWP::UserAgent\n
+",
  "?  print this help\n",
  "\nTAB completion, case insensitive, enabled on all sub namespaces\n
+",
  "$0 by Discipulus as found at perlmonks.org\n\n";

# main extrapolation loop
# we go on fetchin the cpan file
# because now there are only namespaces
while (<$cpanfh>) {
    # AA::BB::CC  0.01 D/DI/DISCIPULUS/AA-BB-CC-0.001.tar.gz
    chomp;
    # split namespaces, version, partial path
    my @fields = split /\s+/;
    # split namespace in AA BB CC
    my @names     = split /::/, $fields[0];
    # die if received invalid data              # or is better /\.gz|z
+ip|tgz|bz2$/ ?
    unless (defined $names[0] and $fields[2]=~ /^[A-Z]{1}\/[A-Z]{2}\/[
+A-Z]+/ ) {
          die "FATAL: no valid data in the file?\nReceived: $_"
              . join ' ',@fields
              ."\n";
    }
    # sanitize names containing ' that seems to valid
    map {s/'/\\'/} @names;
    # @ancestors are @names less last element
    my @ancestors = @names;
    pop @ancestors;
    local $@;
    #
    # evaluate the namespaces in order to build
    # a big hash structure where a namespaces has many key
    # as contained namespaces.
    # additional keys are created to store the name,
    # the parent, and an array with version and partial path
    #
    # start of cpan container; it ends before next = sign
    # AA::BB::CC was splitted in the @names array as:
    # AA BB CC the evaluation transfoms entries in
    # $cpan->{'AA'}{'BB'}{'CC'}
    # but eval autovivifies only BECAUSE there is an assignment: ie:
    # $cpan->{'AA'}{'BB'}{'CC'} =  --hasref with data--
    eval '$cpan->{\''
      . ( join '\'}{\'', @names ) . '\'} ='
      # hasref start
      . '{'
      # hasref . is name and
      . '"."=>$names[-1],' .
      # .. is a ref to father
      # if there is at least one parent
      # now evaluate the path to parent
      # else main cpan hasref is the parent
      '".."=> \%{$cpan'
      . (
        defined $ancestors[0]
        ? '->{\'' . ( join '\'}{\'', @ancestors ) . '\'}'
        : '' )
      . '},'
      # + key is used to store in an array
      # with version and partial path
      . '"+"=> [$fields[1],$fields[2]],'
      .
      # hashref containted in the current key ends here
      '}; ';
      print "WARNING: $@\n\t@fields\n" if $@;
}

# the current hashref namespace starts at top level of the hash
my $current = \%$cpan;
# first time header
&header($current);
# take track of namespaces and, if empty, tell us we are at top level
my @cur_names;

# lines 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;
};
#
# interactive part of the program
while ( defined( $_ = $term->readline( ( join '::', @cur_names ) . '>'
+ ) ) ) {
    # next on empty lines, chomp input otherwise
    /^$/ ? next : chomp;
    # remove eventual spaces on input
    s/\s+//g;
    # if exists the given (input) key (not matching the skip regex) in
    # the current hashref we set current and cur_names and next cycle
    if ( exists $$current{$_} and $_ !~ $skiprx ) {
        $current = \%{ $$current{$_} };
        push @cur_names, $_;
    }
    # . -> ls
    # print current keys (not matching the skip regex)
    elsif ( $_ eq '.' ) {
        print "$_\n" for grep $_ !~ $skiprx, sort keys %$current;
    }
    # + -> ls -l
    # print current keys (not matching the skip regex)
    # with additional infos: version and partial author's path
    # if such infos are not there, the namespace is a container only o
+ne
    elsif ( $_ eq '+' ) {
        foreach my $k ( grep $_ !~ $skiprx, sort keys %$current ) {
            print "$k\t", ${ $current->{$k}{'+'} }[0]
              ? join "\t", @{ $current->{$k}{'+'} }
              : "--CONTAINER NAMESPACE--", "\n";
        }
    }
    # ++ -> tree
    # print current keys (not matching the skip regex)
    # with additional infos: version and partial author's path
    # if such infos are not there, the namespace is a container only o
+ne
    elsif ( $_ eq '++' ) {
        &header($current);
        tree_dump($current);
    }
    # .. -> cd ..
    # go up one level in the datastructure
    elsif ( $_ eq '..' ) {
        pop @cur_names;
        $current =
          \%{ eval '$cpan->{\'' . ( join '\'}{\'', @cur_names ) . '\'}
+'
              || $cpan };
    }
    # * -> dump the readme
    # if LWP::UserAgent is present we fetch the readme file
    # of the current distribution we are navigating.
    # silently skip container only namespaces
    elsif ( $_ eq '*' ) {
        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;
            }
            # rough pagination � la more
            # prints chunks of 20 ($pagination) lines
            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 $_ }
                }
            }
        }
    }
    # ** -> download the package
    # if LWP::UA is present download the current package in the curren
+t dir
    elsif ( $_ eq '**' ) {
        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";
        }
    }
    # ? -> shows infos and help
    # show the content of @infos array
    # id est: headers of the cpan file and usage of the program
    elsif ( $_ eq '?' ) { print for @infos }
    # unknown command
    else                { print "WARNING: '$_' command not found!\n"; 
+next }
}
# in the continue block print the header of current namespace
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";
}
sub tree_dump
{
  my $ref  = shift;
  my $deep = shift || 1;
  foreach my $k (grep  $_ !~ $skiprx, sort keys %{$ref})     {
          print "\t" x $deep . "$k\n";
          if (ref( ${$ref}{$k}) eq 'HASH') {&tree_dump (${$ref}{$k}, (
+$deep+1))}
  }
}
[download]

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 Re^2: CPAN Namespace Navigator: tree dump feature added. by Discipulus
in thread CPAN Namespace Navigator by Discipulus

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 How to display code and escape characters are good places to start.


We don't bite newbies here... much
	PerlMonks