#!perl -l
# perlvars by epoptai
# thanks to japhy for modlist.pl

$start=(times)[0];

use strict qw(subs refs);
use CGI ':standard';
use Pod::Html;
use HTML::Entities;
use FindBin qw($Bin);
use File::Find;
use File::Spec::Functions 'rel2abs';

$ltime= localtime();
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time
+);
$url  = url();
$rurl = url(-relative=>'1');
$qurl = url(-path_info=>'1',-query=>'1');
($name= $rurl)=~s/(.*)\..*/$1/;
$cfg  = $name.'.cfg';
$dat  = $name.'.dat';
$path = $0;
$path =~ s/\/$rurl//o;

&import_names('IN');

unless(eval "require '$dat'"){$nodat=1} else {$nodat=0}
unless(eval "require '$cfg'"){$init=1} else {$init=0}
if(($nodat==1) or ($init==1)){&install()} # find required data files o
+r install

if($IN::go eq 'perlmod'){&perlmod()}
if($IN::go eq 'perldoc'){&perldoc($IN::pm,$IN::title)}
if($IN::go eq 'restore default'){&install()}
if($IN::go eq 'save config'){&config_save();exit}
if($IN::go eq 'home'){ print "Location: $url\n\n"}
if($IN::go eq 'refresh'){ print "Location: $url?rd=1\n\n"}
if($IN::go eq 'update'){&updatedat();exit}
if($IN::go eq 'config'){&configure();exit}
if($IN::go eq ' ? '){&info();exit}
if($IN::go eq ' url '){&selfurls();exit}

if(($IN::file eq 'view') && ($IN::filename)){&view_file()}
if(($IN::file eq 'edit') && ($IN::filename)){&edit_file()}
if(($IN::file eq 'save') && ($IN::filename)){&save_file()}
if(($IN::file eq 'stat') && ($IN::filename)){&stat_file()}

if(($IN::mods eq '1') or ($show_mod eq '1')){&findmodules()}
if( ($IN::env eq '1') or ($show_env eq '1') ){
    foreach $key (keys(%ENV)){ unless($ENV{$key} eq '') {$envtotal++}}
    $check_env = ' checked';
}

($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$bl
+ksize,$blocks) = stat $ENV{'SCRIPT_FILENAME'};
if($IN::rd eq '1'){$check_rdir = ' checked'}

print header,start_html(-title=>'perlvars',-bgcolor=>"$bgc",-text=>"$b
+text",-link=>"$blink",-vlink=>"$bvlink");
print<<HTML;
<form method="get">
<p><TABLE BORDER="$tbd" CELLPADDING=3 cellspacing=1 WIDTH=100% align="
+center">
<tr BGCOLOR="$ta"><th colspan="2" align="left" valign="bottom"><big>
<table border="$tbd" align="right" cellpadding="0" cellspacing="0" bgc
+olor="$tb">
HTML
if(($IN::env eq '1') or ($show_env eq '1')){
    print<<HTML;
    <tr><td align="right"> <small><b>$envtotal</b> </td>
    <td> <small>Environment Variables </td></tr>
HTML
}
if(($IN::mods eq '1') or ($show_mod eq '1')){
    print<<HTML;
    <tr><td align="right"> <font size="-1"><b>$modtotal</b> </td>
    <td> <small>Installed Modules </td></tr>
HTML
}
for(@INC){ if($_ eq '.'){ pop(@INC)}}
print<<HTML;
</table><p><br>

Perl Variables </small>

<input type="submit" name="go" value="config"> <input type="submit" na
+me="go" value=" ? ">
</th></tr>
<TR><TD bgcolor=$tb width=100><b>version</b></TD><TD bgcolor=$tc><tt>$
+]</TD></TR>
<TR><TD bgcolor=$tb><b>executable</b></TD><TD bgcolor=$tc><tt>$^X</TD>
+</TR>
<TR><TD bgcolor=$tb><b>INC</b> </TD><TD bgcolor=$tc><tt>
HTML

for(@INC){ print qq~<a href="file://$_">$_</a>~}

print<<HTML;
<a href=".">.</a></TD></TR>
<TR><TD bgcolor=$tb valign="top"><b>readdir</b></tt> 
HTML
unless($show_dir eq '1'){
    print<<HTML;
    <input type="submit" value=" . "> 
    <input type="checkbox" name="rd" value="1"$check_rdir><p>
HTML
}
if(($IN::rd eq '1') or ($show_dir eq '1')){
    print<<HTML;
    <table border="$tbd" cellspacing=0 cellpadding=0 width=160>
    <tr><td><font size="-2">
File size in bytes is shown for 
text files larger than 30k as a 
warning that they may exceed 
a common html browser 
textarea limit.<p></font></td></tr>
HTML
    if($ENV{'HTTP_USER_AGENT'}=~/MSIE/){
    print<<HTML;
    <tr><td><font size="-2">
    IE may attempt to execute 
    perl scripts if the file extension 
    is associated with perl when 
    "view" is used. Try "edit" 
    instead.<br></font></td></tr>
HTML
        }
print '</table>';
    }
print qq~</TD><TD bgcolor=~;
if(($IN::rd eq '1') or ($show_dir eq '1')){ print qq~$tb>~} else { pri
+nt qq~$tc>~}
if(($IN::rd eq '1') or ($show_dir eq '1')){
    opendir THIS, "." or die "$!";
    while(defined ($_ = readdir(THIS))){
        next if $_ =~ /^\.\.?$/;
        next if -d $_;
#        if(-d $_){$_='/'.$_}; # list dirs
        push @dir, $_;
        }
    closedir THIS;
    @dir = sort { lc($a) cmp lc($b) } @dir;
print<<HTML;
<table border="$tbd" cellpadding=3 cellspacing=0 bgcolor=$tb>
<tr><td rowspan=2 width="10">&nbsp;</td>
<td><small><b>Current directory</b></small><br>
<select name="filename" size="10">
HTML
    for(@dir){
        my$fs  = -s $_;
        if($fs <= 30000){$fss=''}
        if($fs >= 30000){
            unless(-B $_){
                $fs =~ s/(\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/gx;
                $fss="($fs bytes)";
            }
            }
        print qq~<option value="$_">$_ $fss~;
        }
    print<<HTML;
    </select></td><td rowspan=2 width="10">&nbsp;</td></tr>
    <tr><td><input type="submit" name="file" value="view"> 
    <input type="submit" name="file" value="edit"> 
    <input type="submit" name="file" value="stat"> 
    <input type="submit" value="refresh"> 
    </td></tr></table>
HTML
    }
unless(($IN::rd) or ($show_dir eq '1')){ print "$Bin" }

print<<HTML;
</TD></TR>
<TR><TD bgcolor=$tb><input type="submit" name="go" value=" url "></TD>
<TD bgcolor=$tc><a href="$url">$url</a></TD></TR>
<TR><TD bgcolor=$tb width=100><b>OS</b> </TD><TD bgcolor=$tc><tt>$^O</
+TD></TR>
<TR><TD bgcolor=$tb><b>localtime</b> </TD><TD bgcolor=$tc><tt>$ltime</
+TD></TR>
<TR><TD bgcolor=$tb align="right">&nbsp;</TD><TD bgcolor=$tc>
<small><tt>sec=$sec, min=$min, hour=$hour, mday=$mday, mon=$mon, year=
+$year, wday=$wday, yday=$yday, isdst=$isdst</small></TD></TR>
</table>
<TABLE BORDER="$tbd" CELLPADDING=3 cellspacing=1 WIDTH=100%>
<tr BGCOLOR="$ta"><th colspan="2" align="left"><big><p><br><nobr>$envt
+otal 

Environment Variables 

</big>
HTML
unless($show_env eq '1'){
    print<<HTML;
    <input type="checkbox" name="env" value="1"$check_env>
    <input type="submit" value="show">
HTML
    }
print '</th></tr>';
if(($IN::env eq '1') or ($show_env eq '1')){
    for(keys(%ENV)){
        unless($ENV{$_} eq ''){
            if($_=~/DOCUMENT_ROOT|PWD|WINDIR|SCRIPT_FILENAME/){
print "<TR><TD bgcolor=$tb>$_&nbsp;</TD><TD bgcolor=$tc>&nbsp;<a href=
+\"file://" . %ENV->{$_} . "\">" . %ENV->{$_} . "</a></TD></TR>";
            }
            elsif($_=~/PATH/){
%ENV->{$_}=~s/;/; /g;
print "<TR><TD bgcolor=$tb>$_&nbsp;</TD><TD bgcolor=$tc>&nbsp;" . %ENV
+->{$_} . "</TD></TR>";
            }
            elsif($_=~/REMOTE_ADDR/){
print "<TR><TD bgcolor=$tb>$_&nbsp;</TD><TD bgcolor=$tc>&nbsp;<a href=
+\"http://" . %ENV->{$_} . "\">" . %ENV->{$_} . "</a></TD></TR>";
            }
            elsif($_=~/SERVER_ADMIN/){
print "<TR><TD bgcolor=$tb>$_&nbsp;</TD><TD bgcolor=$tc>&nbsp;<a href=
+\"mailto:" . %ENV->{$_} . "\">" . %ENV->{$_} . "</a></TD></TR>";
            }
            elsif($_!~/DOCUMENT_ROOT|PWD|WINDIR|SCRIPT_FILENAME|PATH|R
+EMOTE_ADDR|SERVER_ADMIN/){
print "<TR><TD bgcolor=$tb>$_&nbsp;</TD><TD bgcolor=$tc>&nbsp;" . %ENV
+->{$_} . "</TD></TR>";
            }
        }
    }
}
print "</table>";
print<<HTML;
<TABLE BORDER="$tbd" CELLPADDING=3 cellspacing=1 WIDTH=100%><TR BGCOLO
+R="$ta"><TH colspan=3 align="left"><big><p><br>$modtotal 

Installed Modules 

</b></big>
HTML
unless($show_mod eq '1'){
    print<<HTML;
    <input type="checkbox" name="mods" value="1"$check_mods>
    <input type="submit" value="show">
HTML
    }
if(($IN::mods eq '1') or ($show_mod eq '1')){
    print qq~<input type="submit" name="go" value="update"> ~;
    }
if(($filter eq '1') && (($IN::mods eq '1') or ($show_mod eq '1'))){
    print qq~<br><small><b>$mt2</b> displayed, <b>$mt3</b> filtered (~
+;
    for(@filtered){ print "$_ "}
    print ')</small>';
    }
if(($IN::mods eq '1') or ($show_mod eq '1')){
    print qq~<br><small>Modules without pod * are linked directly to t
+he module.~;
    }
print '</td></tr>';
unless(($IN::mods eq '1') or ($show_mod eq '1')){ print '</table>'}
if(($IN::mods eq '1') or ($show_mod eq '1')){
    if($filter eq '1'){$modtotal=$mt2}
    $third = $modtotal/3;
    $count=0;
    print qq~<TR><TD WIDTH=33% VALIGN=TOP><TABLE BORDER="$tbd" CELLPAD
+DING=3 width=100%>~;
    foreach $mod(@foundmods){ 
        &make($mod); 
        $count++; 
        if($count <= $third){
            print qq~<TR><TD bgcolor="$tc">$root</TD></TR>~;
            }
        else{
            push (@mod1,$mod)
            }
        }
    print qq~</TABLE></TD><TD WIDTH=33% VALIGN=TOP><TABLE BORDER="$tbd
+" CELLPADDING=3 width=100%>~; 
    $count=0;
    foreach $mod1(@mod1){ 
        &make($mod1); 
        $count++; 
        if($count <= $third){
            print qq~<TR><TD bgcolor="$tc">$root</TD></TR>~;
            }
        else{
            push (@mod2,$mod1)
            }
        }
    print qq~</TABLE></TD><TD WIDTH=33% VALIGN=TOP><TABLE BORDER="$tbd
+" CELLPADDING=3 width=100%>~;
    $count=0;
    foreach $mod2(@mod2){
        &make($mod2); 
        $count++; 
        if($count <= $third){
            print qq~<TR><TD bgcolor="$tc">$root</TD></TR>~;
            }
        }
    print qq~</TABLE></td></tr>~;
    }
unless(($IN::mods eq '1') or ($show_mod eq '1')){ 
    print qq~<TABLE BORDER="$tbd" CELLPADDING=3 cellspacing=1 WIDTH=10
+0%>~;
    }
print qq~<TR><TD bgcolor="$ta" colspan="3" align="center">~;
$end=(times)[0];
printf "<small><b>That took %.2F CPU seconds.", $end - $start;
print qq~</TD></TR></TABLE></form>~;
print end_html;
exit(0);

sub findmodules{
for(@INC){ if($_ eq '.'){ pop(@INC)}}
@path{@INC} = (); # modlist.pl - http://www.crusoe.net/~jeffp/programs
+/modlist
for $base (@INC) { find(\&modules, $base) } # ditto
$check_mods = ' checked';
$modtotal = @foundmods;
if($filter eq '1'){
    for(@foundmods){
        $off=0;
        $mname=$_;
        @fm = split(/::/,$_);
        $fm = shift(@fm);
        for(@filtered){    if($_ eq $fm){$off=1}}
        unless($off==1){$fms{$mname}=1}
        }
    @foundmods = keys(%fms);
    $mt2 = @foundmods;
    $mt3 = ($modtotal-$mt2);
#    $modtotal = $mt2;
    }
@foundmods = sort { lc($a) cmp lc($b) } (@foundmods);
}

sub modules { # sub from modlist.pl - http://www.crusoe.net/~jeffp/pro
+grams/modlist
  $File::Find::prune = 1, return if
    exists $path{$File::Find::dir} and $File::Find::dir ne $base; 

$f = $File::Find::name; # < added
if($f=~/\.pm$/){        #
    push @files, $f;    #
    }                   # 
@files = sort @files;    # <

  my $module = substr $File::Find::name, length $base;
  return unless $module =~ s/\.pm$//;
  $module =~ s!^/+!!;
  $module =~ s!/!::!g;
#  $module =~ tr!A-Z!a-z!;
  push @foundmods, $module;
#  print qq~<li>$module~;
}


sub make{
my$var   = shift;
my@smn   = split(/::/,$var);
my$name  = pop(@smn);
my$foo   = shift(@smn);

for(@files){ 
    if($_=~/$foo.*$name\.pm/){
        unless($modpath{$var}){$modpath{$var}=$_}
        }
    }
for(keys(%moddat)){
    if($_ eq $var){
        if($moddat{$_}==1){
            $root=qq(<small><a href="$url?go=perldoc&pm=$modpath{$var}
+&title=$var" target="$target">$var</a>);
            }
        if($moddat{$_}==0){
            $root=qq(<small><a href="$url?go=perlmod&pm=$modpath{$var}
+&title=$var" target="$target">$var</a>$markpm);
            }
        }
    }
}

sub updatedat{
&makedat();
print header,start_html(-title=>"module list updated",-bgcolor=>"$bgc"
+,-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink"),h1('Updated'),p("
+Module list <a href='$dat'><i>$dat</i></a> updated with $modtotal mod
+ules"),hr,p(a({-href=>"$url"},'Reload'));
}

sub makedat{
&findmodules();
for(@foundmods){
    my$var   = $_;
    my@smn   = split(/::/,$var);
    my$lname = pop(@smn);
    my$foo = pop(@smn);
    for(@files){
        if($_=~/$foo.$lname\.pm/){
            open(IT,"< $_") or next; 
            local $/ = undef;
            my$it=<IT>;
            close(IT) or die "Couldn't close module: $!";
            if($it=~/=cut/ or /=head/ or /=item/){$rec{$var}=1}
            else{$rec{$var}=0}
            }
        }
    }
open(FILE,"> $dat") or die "$!";
print FILE qq~%moddat=(~;
for(sort { lc($a) cmp lc($b) } keys(%rec)){
    print FILE qq~$_=>$rec{$_},~;
    }
print FILE qq~);~;
close(FILE) or die "$!";
}

sub perlmod{
    open(MU,"< $IN::pm") or die "$!"; 
    local $/ = undef;
    my$it=<MU>;
    close(MU) or die "$!";
    print header(-type=>'text/html'),start_html(-title=>"$IN::title",-
+bgcolor=>"$bgc",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink"),pr
+e("$it");exit
}

sub perldoc{ 
$pod = $^T;
pod2html( "--htmlroot=$Bin",
          "--infile=$_[0]",
          "--outfile=$pod.html",
          "--title=$_[1]",
);
open(IT,"< $pod.html") or die "$!"; 
local $/ = undef;
my$it=<IT>;
close(IT) or die "$!";
unlink "$pod.html";
print header(-type=>'text/html'),start_html(-title=>"$IN::title",-bgco
+lor=>"$bgc",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink"),p("$it
+");exit
}

sub check_type{
    $file=$IN::filename;
    if(-B $file){$type='binary'}
    if(-T $file){$type='text/plain'}
    if(   $file=~/\.s?html?/i){$type='text/html'}
    if($file=~/\.gif/i){$type='image/gif'}
    if($file=~/.jpe?g?/i){$type='image/jpeg'}
}

sub view_file{
&check_type();
if($type=~/text/){
    print header(-type=>"$type");
    if($type=~/html/){ print start_html(-title=>"viewing $IN::filename
+",-bgcolor=>"$bgc",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink")
+}
    open(FILE, "< $file") or die "$!"; 
    local $/ = undef;
    my$data = <FILE>;
    close(FILE) or die "$!";
    print $data;
    }
if($type=~/image/){
    print "Location: $file\n\n";
    }
if($type=~/binary/){
    print header,start_html(-title=>'Unsupported Binary',-bgcolor=>"$b
+gc",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink"),h1('Unsupporte
+d Binary'),p('Only GIF and JPEG binaries can be viewed.'),hr,("<noscr
+ipt><strike></noscript><a href='javascript:history.go(-1)'>Ok</a><nos
+cript></strike></noscript>");
    }
exit;
}

sub edit_file{
&check_type();
if($type =~ /image/){ 
    print header,start_html(-title=>'Feature not yet implemented',-bgc
+olor=>"$bgc",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink"),p,br,
+blockquote,p("Images can only be <a href='$url?filename=$IN::filename
+&file=view'>viewed</a>");
    exit;
    }
if($type=~/binary/){
    print header,start_html(-title=>'Unsupported Binary',-bgcolor=>"$b
+gc",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink"),h1('Unsupporte
+d Binary'),p('Only text files can be edited.'),hr("<noscript><strike>
+</noscript><a href='javascript:history.go(-1)'>Ok</a><noscript></stri
+ke></noscript>");
    exit;
    }
$fs = -s $IN::filename;
open (FILE, "< $IN::filename") or die "$!"; 
local $/ = undef;
my$file = <FILE>;
close(FILE) or die "$!";
&encode_entities($file);
print header,start_html(-title=>"editing $IN::filename",-bgcolor=>"$bg
+c",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink");
my$fc = (length($IN::filename)+3);
($fL = $0) =~ s/$rurl$//o;
print<<HTML;
<table border="$tbd" cellpadding=0 cellspacing=0><tr><form method="pos
+t"><td>
<input type="hidden" name="file" value="save">
<input type="submit" value="save file as"> 
<input type="text" name="filename" value="$IN::filename" size="$fc"> 
HTML
if($fs <= 30000){
    print qq~<small>($fs bytes) in <a href="file://$fL">$fL</a></small
+>~;
    }
if($fs >= 30000){
    print<<HTML;
    <font size="-1" color="#ff0000">($fs bytes) in <a href="file://$fL
+">$fL</a></font></font><blockquote>
    <small>If a large text file was selected and the textarea 
    is empty your browser<br>has a textarea limit. This warning appear
+s 
    on files >= 30k.<br></small></blockquote>
HTML
    }
print<<HTML;
<textarea name="filebody" rows="40" cols="80" wrap="virtual">$file<\/t
+extarea>
</td></form></tr></table>
HTML
print end_html;
exit;
}

sub stat_file{
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$bl
+ksize,$blocks) = stat $IN::filename;
print header,start_html(-title=>"stat $IN::filename",-bgcolor=>"$bgc",
+-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink");
print<<HTML;
<table border="$tbd" cellspacing=1 cellpadding=3 bgcolor="$tb">
<tr><td colspan=2 bgcolor="$ta"><h2>results of <tt>stat $IN::filename<
+/tt></h2></td></tr>
<tr><th align=left>
Field</th><th align=left>Value</th></tr>
<tr><td> 
Device number of filesystem </td><td>$dev &nbsp;</td></tr><tr><td> 
Inode number </td><td>$ino &nbsp;</td></tr><tr><td> 
File mode (type and permissions) </td><td>$mode &nbsp;</td></tr><tr><t
+d> 
Number of (hard) links to the file </td><td>$nlink &nbsp;</td></tr><tr
+><td> 
Numeric user ID of file's owner </td><td>$uid &nbsp;</td></tr><tr><td>
+ 
Numeric group ID of file's owner </td><td>$gid &nbsp;</td></tr><tr><td
+> 
The device identifier (special files only) </td><td>$rdev &nbsp;</td><
+/tr><tr><td> 
Total size of file, in bytes </td><td>$size &nbsp;</td></tr><tr><td> 
Last access time since the epoch </td><td>$atime &nbsp;</td></tr><tr><
+td> 
Last modify time since the epoch </td><td>$mtime &nbsp;</td></tr><tr><
+td> 
Inode change time <small>(NOT creation time!)</small> since the epoch 
+</td><td>$ctime &nbsp;</td></tr><tr><td> 
Preferred blocksize for file system I/O </td><td>$blksize &nbsp;</td><
+/tr><tr><td> 
Actual number of blocks allocated </td><td>$blocks &nbsp;</td></tr>
<tr><td bgcolor="$ta"> 
Current time since the epoch </td><td>
$^T &nbsp;</td></tr>
<tr><td colspan=2 bgcolor="$ta" align="right">
<noscript><strike></noscript><a href="javascript:history.go(-1)">ok</a
+><noscript></strike></noscript></td></tr>
</table>
HTML
print end_html;
exit;
}

sub save_file{
&decode_entities($IN::filebody);
open (FILE, "> $IN::filename") or die "$!";
print FILE $IN::filebody;
close(FILE) or die "$!";
print header,start_html(-title=>'File Saved',-bgcolor=>"$bgc",-text=>"
+$btext",-link=>"$blink",-vlink=>"$bvlink"),h1('File Saved');
print qq~<a href="$IN::filename">$IN::filename</a> saved in <i>$Bin</i
+><hr><noscript><strike></noscript><a href="javascript:history.go(-2)"
+>return</a><noscript></strike></noscript>~;
exit;
}

sub selfurls{
$url3 = url(-absolute=>1);
$url4 = url(-path_info=>1);
$url5 = url(-path_info=>1,-query=>1);
($url5 = $url5) =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;
$url5 =~ tr/ /+/;
print header,start_html(-title=>'urls',-bgcolor=>"$bgc",-text=>"$btext
+",-link=>"$blink",-vlink=>"$bvlink");
print table({-border=>"$tbd",-bgcolor=>"$tc",-cellspacing=>'1',-cellpa
+dding=>'4'},
Tr([td({-colspan=>'2',-bgcolor=>"$ta"},font({-size=>'+2'},b(tt('Full P
+ath to this script by various methods'))))]),
Tr({-align=>'left',-bgcolor=>'dddddd'},[th('method').th('result')]),  
+  
Tr([td({-colspan=>'2',-bgcolor=>"$tb"},small(b('system  paths')))]),
Tr([td(tt('$0')).td($0)]),    
Tr([td(tt('FindBin($Bin)')).td($Bin)]),
Tr([td(tt('rel2abs($0)')).td(rel2abs($0))]),
Tr([td({-colspan=>'2',-bgcolor=>"$tb"},small(b('web paths')))]),
Tr([td("<tt>\$ENV{'SCRIPT_NAME'}").td($ENV{'SCRIPT_NAME'})]),
Tr([td(tt('$q->url()')).td($url)]),
Tr([td(tt('$q->url(-relative=>1)')).td($rurl)]),
Tr([td(tt('$q->url(-absolute=>1)')).td($url3)]),
Tr([td(tt('$q->url(-path_info=>1)')).td($url4)]),
Tr([td(tt('$q->url(-path_info=>1,-query=>1)')).td(small("$url5"))]),  
+  
Tr([td({-colspan=>'2',-bgcolor=>"$tb",-align=>'right'},"<noscript><str
+ike></noscript><a href='javascript:history.go(-1)'>ok</a><noscript></
+strike></noscript>")]),    
);
print end_html;
}

sub configure{
if($show_dir eq '1'){$checkp_dir=' checked'}
if($show_env eq '1'){$checkp_env=' checked'}
if($show_mod eq '1'){$checkp_mod=' checked'}
if($filter eq '1'){$checkp_filter=' checked'}
print header,start_html(-title=>'configure perlvars.pm',-bgcolor=>"$bg
+c",-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink");
print<<HTML;
<table border="$tbd" width="100%" cellpadding="4" cellspacing="1">
<tr bgcolor="$ta"><form method="post"><td>
<h1>

Configure perlvars</h1></td><td align=right>

<input type="submit" name="go" value="save config"> 
<input type="submit" name="go" value="home"></td></tr>
<tr><td colspan="2" bgcolor="$tb"><h3>

Display Preferences</td></tr>

<tr bgcolor="$tc"><td align="center">
<table cellspacing="1" cellpadding="2" border="$tbd" bgcolor="$tb" wid
+th="80%">
<tr><td colspan="2"><small>If expand is checked the section 
will be expanded by default, otherwise a check box and expand button 
will appear near the section title.<br>
</td></tr>
<tr align="left"><th>section</th><th>expand</th></tr><tr>
    <td>readdir</td>
    <td><input type="checkbox" name="show_dir" value="1"$checkp_dir></
+td>
</tr><tr>
    <td>environment variables</td>
    <td><input type="checkbox" name="show_env" value="1"$checkp_env></
+td>
</tr><tr>
    <td>installed modules</td>
    <td><input type="checkbox" name="show_mod" value="1"$checkp_mod></
+td>
</tr>
<tr><td colspan="2" height="10">&nbsp;</td></tr>
<tr>
    <td><ul><li><small>mark non-pod links with a</ul></td>
    <td><input type="text" name="markpm" value="$markpm" size="1" maxl
+ength="1"></td>
</tr><tr>
    <td><ul><li><small>windowname for mod docs</ul></td>
    <td><input type="text" name="target" value="$target" size="10"></t
+d>
</tr><tr>
    <td><ul><li>filter modules <input type="checkbox" name="filter" va
+lue="1"$checkp_filter><br>
    <font size="-1">module dirs excluded from display</font><br></td>
    <td><input type="text" name="filtered" value="@filtered" size="22"
+></td>
</tr><tr>
    <td colspan="2"></td>
</tr>
</table>
</td><td>
<table cellspacing="1" cellpadding="2" border="$tbd" bgcolor="$tb">
<tr align="left"><th>element</th><th>value</th></tr><tr>
    <td><small>background color</td>
    <td><input type="text" name="bgc" value="$bgc"></td>
</tr><tr>
    <td><small>text color</td>
    <td><input type="text" name="btext" value="$btext"></td>
</tr><tr>
    <td><small>link color</td>
    <td><input type="text" name="blink" value="$blink"></td>
</tr><tr>
    <td><small>visited link color</td>
    <td><input type="text" name="bvlink" value="$bvlink"></td>
</tr><tr>
    <td><small>table shade light</td>
    <td><input type="text" name="tc" value="$tc"></td>
</tr><tr>
    <td><small>table shade medium</td>
    <td><input type="text" name="tb" value="$tb"></td>
</tr><tr>
    <td><small>table shade dark</td>
    <td><input type="text" name="ta" value="$ta"></td>
</tr><tr>
    <td><small>table border</td>
    <td><input type="text" name="tbd" value="$tbd" size="2"></td>
</tr></table>
</td></tr>
<tr><td colspan="2" bgcolor="$tb"><input type="submit" name="go" value
+="restore default">
<small> will overwrite current config with a fresh default.</td></form
+></tr></table>
HTML
exit;
}

sub info{
print header,start_html(-title=>"$rurl",-bgcolor=>"$bgc",-text=>"$btex
+t",-link=>"$blink",-vlink=>"$bvlink");
print<<HTML;
<body bgcolor="$bgc">
<table border="$tbd" cellspacing=1 cellpadding=3 bgcolor="$tb" width="
+70%" align="center">
<tr><td bgcolor="$ta"><h1>$rurl</h1></td></tr>
<tr><td><p><br><blockquote>
<b>perlvars</b> is based on the concept of <a href="http://www.scripts
+olutions.com/programs/free/perldiver/" target="_blank">ScriptSolution
+s'</a> great free unix-oriented 
<i>perl diver</i> which lists useful environment variables and install
+ed perl modules. 
It was written so these functions could be expanded upon and enjoyed u
+nder Win32 as well as Unix systems.
<p>
<h2>Also in perlvars:</h2>
<ul>
<li>Listed modules are linked to their documentation. Either an html r
+endering of the pod 
or raw module source code.<p>
<li>Control panel to customize preferences.<p>
<li>Automatic configuration file creation if either $cfg or $dat are n
+ot found in the current directory.<p>
<li>Directory browser that can view, edit and stat local files. Stat a
+pplies to all files, 
text files with any extension can be viewed and edited, jpeg and gif i
+mages can be viewed. 
Unfortunately, text files larger than a given browser software's texta
+rea limit cannot be 
edited.<p>
</ul>
<h3>Credits:</h3>
Coded by <a href="http://perlmonks.org/index.pl?node=epoptai" target="
+_blank">epoptai</a><br>
<a href="http://www.crusoe.net/~jeffp/programs/modlist" target="_blank
+">modlist.pl</a> - getting a list of modules<br>
<a href="http://www.scriptsolutions.com/programs/free/perldiver/" targ
+et="_blank">
perldiver.pl</a>- splitting module table into thirds<br><p><br></td></
+tr>
<tr><td bgcolor="$ta" align="right"><noscript><strike></noscript>
<a href="javascript:history.go(-1)">Ok</a><noscript></strike></noscrip
+t><noscript> or 
<a href="$url">Ok</a></noscript></td></tr>
</table>
<p>
HTML
print end_html;
}

sub config_save{
%cfg = (
bgc    => "\$bgc='$IN::bgc';",
btext  => "\$btext='$IN::btext';",
blink  => "\$blink='$IN::blink';",
bvlink => "\$bvlink='$IN::bvlink';",
   tc  => "\$tc='$IN::tc';",
   tb  => "\$tb='$IN::tb';",
   ta  => "\$ta='$IN::ta';",
   tbd => "\$tbd='$IN::tbd';", 
   dir => "\$show_dir='$IN::show_dir';",
   env => "\$show_env='$IN::show_env';",
   mod => "\$show_mod='$IN::show_mod';",
target => "\$target='$IN::target';",
markpm => "\$markpm='$IN::markpm';",
filter    => "\$filter='$IN::filter';",
filtered  => "\@filtered=qw($IN::filtered);",
);
open (FILE, "> $cfg") or die "Problem saving config file: $!";
for(keys(%cfg)){ 
    print FILE qq($cfg{$_})
    }
print FILE "\n1;\n";
close(FILE) or die "$!"; 
print header,start_html(-title=>'Configuration Saved',-bgcolor=>"$bgc"
+,-text=>"$btext",-link=>"$blink",-vlink=>"$bvlink");
    if($IN::show_dir eq '1'){$showdir='yes'} else {$showdir='no'}
    if($IN::show_env eq '1'){$showenv='yes'} else {$showenv='no'}
    if($IN::show_mod eq '1'){$showmod='yes'} else {$showmod='no'}
    if($IN::filter eq '1'){$filt='yes'} else {$filt='no'}
    if($IN::diag eq '1'){$dia='On'} elsif($IN::diag eq '0'){$dia='Off'
+}
    print<<HTML;
<table border="$tbd" width="100%" cellpadding="4" cellspacing="1"><tr 
+bgcolor="$ta"><form><td>
<h1>

Configuration Saved

</h1></td><td align=right>
<input type="submit" name="go" value="config"> 
<input type="submit" name="go" value="home"></td></tr>
<tr><td colspan="2" bgcolor="$tb"><h3>
Display Preferences</td></tr>
<tr bgcolor="$tc"><td align="center">
<table cellspacing="1" cellpadding="4" border="$tbd" bgcolor="$tb">
<tr align="left"><th>section</th><th>expand</th></tr><tr>
<td>readdir</td><td><tt>$showdir</td></tr>
<tr><td>environment variables</td><td><tt>$showenv</td></tr>
<tr><td>installed modules</td><td><tt>$showmod</td></tr>
<tr><td colspan="2" height="10">&nbsp;</td></tr>
<tr><td>display window</td><td><tt>$target</td></tr>
<tr><td>marking non-pod links with a</td><td><tt>$IN::markpm</td></tr>
<tr><td>filter modules</td><td><tt>$filt</td></tr>
<tr><td>filtered modules</td><td><tt>$IN::filtered&nbsp;</td></tr>
</table>
</td><td align="center">
<table cellspacing="1" cellpadding="4" border="$tbd" bgcolor="$tb">
<tr align="left"><th>element</th><th>value</th></tr>
<tr><td><small>background color</td><td><tt>$IN::bgc</td></tr>
<tr><td><small>text color</td><td><tt>$IN::btext</td></tr>
<tr><td><small>link color</td><td><tt>$IN::blink</td></tr>
<tr><td><small>visited link color</td><td><tt>$IN::bvlink</td></tr>
<tr><td><small>table shade light</td><td><tt>$IN::tc</td></tr>
<tr><td><small>table shade medium</td><td><tt>$IN::tb</td></tr>
<tr><td><small>table shade dark</td><td><tt>$IN::ta</td></tr>
<tr><td><small>table border</td><td><tt>$IN::tbd</td></tr>
</table>
</td></tr>
<tr><td colspan="2" bgcolor="$tb">&nbsp;</td></tr></table>
HTML
print end_html;
exit
}

sub install{
print header,start_html(-title=>'install perlvars.pm'),h1('Installatio
+n');
if($IN::go eq 'restore default'){ print 'Default configuration restore
+d' }
print ol;
if(($init==1)){
    print qq~<li>Data file <i>$cfg</i> not detected in <i>$path</i><br
+>~;
    }
if(($init==1) or ($IN::go eq 'restore default')){
    while(<DATA>){$df .= $_} # read data
    open (FILE, "> $cfg") or die "$!";
    print FILE $df;
    close(FILE) or die "$!";
    print qq~<li><b>Created data file <i>$path/<a href="$cfg">$cfg</a>
+</i></b>~;
    }
if($nodat==1){
    print qq~<li>Data file <i>$dat</i> not detected in <i>$path</i><br
+>~;
    &makedat();
    print qq~<li><b>Created data file <i>$path/<a href="$dat">$dat</a>
+</i></b>~;
    }
print<<HTML;
</ol><hr>
Ready to <a href="$url">reload</a> or <a href="$url?go=config">configu
+re</a>
HTML
exit
}

__END__
$bgc='#d0d0d0';
$btext='#000000';
$blink='#0000ff';
$bvlink='#6600aa';
$tbd='0';
$tc='#c0c0c0';
$tb='#b0b0b0';
$ta='#a0a0a0';
$show_dir='';
$show_env='1';
$show_mod='1';
$markpm='*';
$target='docs';
$filter='';
@filtered=qw(Tk);