Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Comment on

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

.. 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))} } }
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

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



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (3)
    As of 2018-07-18 01:10 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















      Results (382 votes). Check out past polls.

      Notices?