#!perl my $ua; BEGIN{ my $ua; local $@; eval{ require LWP::UserAgent; #LWP::UserAgent->import; $ua = LWP::UserAgent->new; }; if ($@){warn "WARNING: no LWP::UserAgent support!"} if ($@ and !$ARGV[0]){die "FATAL: no filename as argoument nor LWP::UserAgent support!\n"} eval{ require Term::ReadKey; #Term::ReadKey->import; #$ua = LWP::UserAgent->new; }; if ($@){warn "WARNING: no Term::ReadKey support!"} #our $ua = LWP::UserAgenta->new; } my $ua; print $ua; #exit; use strict; use warnings; use feature qw (say); $|=1; use Diagnostics; use Data::Dumper; use Data::Dump::Streamer; my $cpan = {'.'=>'CPAN'}; #_=>'',__=>'' my $skiprx = qr/^[\.\+]{1,2}$/; #our @names; &grow_tree; sub grow_tree { while (){ chomp; my @fields = split /\s+/;#say "@fields"; my @names = split /::/, $fields[0];#say "names($#names): @names"; my $cur; my @ancestors = @names; pop @ancestors; eval '$cpan->{'. # start od cpan container (join '}{', @names).'} ='. # expand names and vivifies because there is assignment '{'. # hasref start '"."=>$names[-1],'. '".."=> \%{$cpan'.(defined $ancestors[0] ?'->{'.(join '}{', @ancestors ).'}':'').','.'},'. '"+"=> [$fields[1],$fields[2]],'. '}; '; # hashref end } Dump($cpan); } my $current = \%$cpan;&header($current); my @cur_names; while(){ chomp; if (exists $$current{$_} and $_ !~ $skiprx) { $current = \%{$$current{$_}}; push @cur_names, $_; next; } # . -> ls elsif($_ eq '.'){ say for grep $_ !~ $skiprx, keys %$current; } # + -> ls -l elsif($_ eq '+'){ foreach my $k(grep $_ !~ $skiprx, keys %$current) { print "$k\t", ${$current->{$k}{'+'}}[0] ? join "\t", @{$current->{$k}{'+'}} : "--CONTAINER NAMESPACE--","\n"; } } # .. -> cd .. elsif($_ eq '..'){ ref $current->{'..'} eq 'HASH' ? say "ok father defined for $current->{'.'}" : say "WARN no father defined"; #$current = \%{$current->{__}}||\%$cpan; $current = ref $current->{'..'} eq 'HASH' ? \%{$current->{'..'}}: \%$cpan; pop @cur_names; } # * -> dump the readme elsif($_ eq '*'){ #foreach my $k (keys %$current) {next if $k=~$skiprx;print "$k @{$current->{$k}{'+'}}\n"} if (defined $$current{'+'}->[0]) { print "$$current{'.'} ". ($$current{'+'}->[0]||'').#($$current{'+'}->[0] ? $$current{'+'}->[0] : ''). "\n"; my $url = 'http://www.cpan.org/authors/id/'.$$current{'+'}->[1]; $url =~s/\.tar\.gz/\.readme/; print "URL: $url\n"; print LWP::UserAgent->new->get($url)->content() ; } } else{next} } continue{&header($current); #print "CURRENT: ",$$current{_},"\n"; } sub header { my $hr = shift; print "-" x 35,"\n"; #print "# CURRENT: ",($$hr{'.'}or 'EMPTY')," has ",(scalar@{[grep !$skiprx, keys %$hr]} or 'no')," namespaces\n"; print +(join '::',@cur_names or 'CPAN'), ($$hr{'+'}->[0] ? "\t$$hr{'+'}->[0]" : "\t"), "\thas ",(scalar@{[grep $_ !~ $skiprx, keys %$hr]})," namespaces\n"; #print "#" x 35,"\n"; } __DATA__ ABI 1.0 M/MA/MALAY/ABI-1.0.tar.gz A 0.5 I/ID/IDOPEREL/Abilities-0.5.tar.gz A::BB 0.5 I/ID/IDOPEREL/Abilities-0.5.tar.gz A::CC 0.2 I/ID/IDOPEREL/Abilities-0.2.tar.gz A::CC::DD 0.2 I/ID/fake/Abilities-0.2.tar.gz XX::ZZ::YY 0.1 I/jhsjkha