'.Data::Dumper->Dump([\%found],[qw(found)]).''; } $p .= end_html if %i && !$i{perlpod}; print $p; # there can be only one sub listmods { # display the module list my $total = findmodules(); # populate %found $p .= qq~ Perl : $]
Show environment variables
Paths to this script
About -
top
$total Installed Modules re
';
if($i{num}){
my @it = load($i{pm}); # TAINTED
my $c = 1;
for(@it){
$_ = encode_entities($_);
$p .= qq~$c. $_~;
$c++
}
}
else{
my $it = load($i{pm}); # TAINTED
$it = encode_entities($it);
$p .= $it
}
$p .= ''
}
sub synopsis
{ # eval code from a synopsis form
return if $i{strip_html};
unless($i{noheader}){
$i{htmlhead} ? print header : print header('text/plain');
}
# turn strict off by default for the eval form
no strict;
eval $i{synopsis} if $synopsis_code_form; # TAINTED, ETC
print $@ if $@;
exit
}
sub codeform
{ # display synopsis code in a form
my($front,$coded,$rear) = @_;
my @coded = split /\n/, $coded;
my (%len,$c,$ex);
for(@coded){ # determine width of textarea
my $l = length($_);
$len{$l} = $l
}
for(sort { $b <=> $a } keys %len){
$c = $len{$_};
last
}
my $r = @coded; # determine height of textarea
$coded =~ s|||ig;
$coded =~ s|<[^>]+>||g if $i{strip_html};
if($coded =~ m|<[^>]+>|){
$ex = qq~
~;
$ex .= qq~~ if $i{perlpod};
$ex .= qq~~ if $i{perlmod};
}
$ex = '' if ! $ex;
$coded = qq~$front $rear~; return $coded } sub view { # view file, any arg toggles text mode if(-e $i{pm}){ my $it = load($i{pm}); # TAINTED $it = encode_entities($it) and $p .= '
'.$it.'' if $_[0]; # text $p .= $it if !$_[0]; } else{ $p .= '
File does not exist!' } } sub env { # show environment variables my $v = keys %ENV; $p .= qq~
$v Environment Variables
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| $_ | $ENV{$_} |
| |||||||||
~;
findmodules(); # returns %found
my %abc = ();
for(keys %found){
my $ltr = '';
m|^(.)|;
$ltr = lc($1) if $1;
$abc{$ltr}++; # only show letters that exist
}
$p .= qq~^ ~;
for(sort {$a cmp $b} keys %abc){
$p .= qq~$_ ~
}
$p .= qq~
~;
}
sub selfurls
{ # show paths
my $rurl = url(-relative=>'1');
my $url3 = url(-absolute=>1);
my $url4 = url(-path_info=>1);
my $url5 = url(-path_info=>1,-query=>1);
$p .= '
';
$p .= table({-border=>"1",-cellspacing=>'0',-cellpadding=>'6',-align=>'center'},
Tr([td({-colspan=>'2',},font({-size=>'+2'},b(tt('Path to this script by various methods'))))]),
Tr({-align=>'left'},[th('method').th('result')]),
Tr([td({-colspan=>'2'},small(b('System')))]),
Tr([td(tt('$0')).td($this)]),
Tr([td(tt('rel2abs($0)')).td(rel2abs($this))]),
Tr([td(tt('FindBin($Bin)')).td($Bin)]),
Tr([td({-colspan=>'2'},small(b('Environment Variables')))]),
Tr([td("\$ENV{'SCRIPT_NAME'}").td($ENV{'SCRIPT_NAME'})]),
Tr([td("\$ENV{'REQUEST_URI'}").td($ENV{'REQUEST_URI'})]),
Tr([td("\$ENV{'SCRIPT_FILENAME'}").td($ENV{'SCRIPT_FILENAME'})]),
Tr([td("\$ENV{'PWD'}").td($ENV{'PWD'})]),
Tr([td({-colspan=>'2'},small(b('CGI Module')))]),
Tr([td(tt('url()')).td($url)]),
Tr([td(tt('url(-relative=>1)')).td($rurl)]),
Tr([td(tt('url(-absolute=>1)')).td($url3)]),
Tr([td(tt('url(-path_info=>1)')).td($url4)]),
Tr([td(tt('url(-path_info=>1,-query=>1)')).td($url5)]));
}
sub cache
{ # create or delete cache file
if($i{make}){
%found = ();
my $total = findmodules(); # repopulate %found
$total = 1 if -e $cache;
open FILE, "> $cache" or die "Could not create cache file $cache: $!";
print FILE Data::Dumper->new([\%found],['$found'])->Indent(0)->Quotekeys(0)->Dump;
close FILE;
$_ = 'Created';
$_ = 'Refreshed' if $total == 1;
$p .= qq~$_ cache file $cache~;
}
if($i{dele}){
unlink $cache;
$p .= qq~Could not delete cache file $cache: $!~ if $!;
$p .= qq~Deleted cache file $cache~ if !$!
}
$p .= qq~
ok~ } __END__ =head1 NAME MODULATOR =head1 DESCRIPTION Browse pod and code of installed perl modules. =head1 FUNCTIONS Lists each installed perl module linked to an HTML rendering of its pod if any. The degree sign links to the source code of each module. The asterisk links to line numbered source code of each module. Option to automatically put synopsis code into a form for easy testing via eval. Lists environment variables and result of various path and url finding methods. Can create a cache file to improve performance. =head1 COPYRIGHT? This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR http://perlmonks.org/index.pl?node=epoptai =cut