#!/usr/bin/perl 

## Enviroment Variables Plus  v1.0     Released: 9-1-00
## by NESGamepro   http://www.wtv-zone.com/nesgamepro

# You may have to change the path above to #!/usr/local/bin/perl if the
#  script is not working.

# Name this file anything.pl or anything.cgi and change permissions 
# (CHMOD) the file to 755.

# By using this script you agree that NESGamepro is not responsible 
#  for any damages caused by it, either directly or indirectly.
# Sole responsibility is placed on the owner of this copy.

# There is no need to edit below this line
use File::Find;

$plocation  =`whereis perl`;
@perlloc = split(" ",$plocation);
$sendmail =`whereis sendmail`;
@mailloc = split(" ",$sendmail);
$dateprog =`whereis date`;
@dateloc = split(" ",$dateprog);

print "Content-type: text/html\n\n"; 

## ENV Vars
print "<table width=100% border=1><tr><td colspan=3 align=center><b>Environment Variables</b></td></tr>";
while (($key,$value) = each %ENV) { print "<tr><td width=40% valign=top>$key<td width=60%>$value</td></tr>"; }

## More Vars
print <<EndMoreVars;
<tr><td valign=top>Debug Flags:</td><td valign=top>$^D</td></tr>

<tr><td valign=top>Debugger Flag:</td><td valign=top>$^P</td></tr>

<tr><td valign=top>Warning Switch Value:</td><td valign=top>$^W</td></tr>

<tr><td valign=top>Perl Executable:</td><td valign=top>$^X</td></tr>

<tr><td valign=top>Perl Process Number:</td><td valign=top>$$</td></tr>

<tr><td valign=top>Perl being Executed:</td><td valign=top>$0</td></tr>

<tr><td valign=top>Perl Version:</td><td valign=top>$]</td></tr>

<tr><td valign=top>PERL compile version OS:</td><td valign=top>$^O</td></tr>

<tr><td valign=top>Script Start Time:</td><td valign=top>$^T</td></tr>

<tr><td valign=top>Real UID:</td><td valign=top>$<</td></tr>

<tr><td valign=top>Effective UID:</td><td valign=top>$></td></tr>

<tr><td valign=top>Real GID:<br>
(If not blank, your server supports membership in multiple groups simultaneously)</td><td valign=top>$(</td></tr>

<tr><td valign=top>Effective GID:<br>
(If not blank, your server that supports membership in multiple groups simultaneously)</td><td valign=top>$)</td></tr>
EndMoreVars
print "</table><p>";

## Server Program Paths
print "<table width=100% border=1><tr><td colspan=2 align=center><b>Server Program Paths;</b></td></tr>";
print "<tr><td valign=top width=40%>Location of Perl:</td><td valign=top width=60%>"; foreach $loc(@perlloc) { print "$loc<br>\n";} print "</td></tr>";

print "<tr><td valign=top>Location of Sendmail:</td><td valign=top>";
foreach $loc(@mailloc) { print "$loc<br>\n";} print "</td></tr>";

print "<tr><td valign=top>Location of Date:</td><td valign=top>";
foreach $loc(@dateloc) { print "$loc<br>\n";} print "</td></tr>";

print "<tr><td valign=top>Directory locations searched for perl executables:</td>
<td align=top>";
foreach $item(@INC) { print "$item<br>\n";} print "</td></tr>";
print "</table><p>";

## Show Modules
print "<table width=100% border=1><tr><td colspan=3 align=center><b>Installed Modules</b></td></tr>";

find(\&wanted,@INC);

$modcount = 0;
foreach $line(@foundmods) {  $match = lc($line); 
 if ($found{$line}[0] >0) {$found{$line} = [$found{$line}[0]+1,$match]} 
 else  {$found{$line} = ["1",$match]; $modcount++ } }
@foundmods = sort count keys(%found);
sub count {return $found{$a}[1] cmp $found{$b}[1] }

$third = $modcount/3;

print "<tr><td width=33% valign=top><table cellpadding=1>";

$count=0;
foreach $mod(@foundmods) { chomp $mod; $count++; 
if ($count <= $third) { print "<tr><td>$mod</td></tr>";  }
else {push (@mod1,$mod) } }

print "</table></td><td width=33% valign=top><table cellpadding=1>";

$count = 0;
foreach $mod1(@mod1) { chomp $mod1;  $count++;
if ($count <= $third) { print "<tr><td>$mod1</td></tr>";  }
else { push (@mod2,$mod1) } }

print "</table></td><td width=33% valign=top><table cellpadding=1>";

$count = 0;
foreach $mod2(@mod2) { chomp $mod2;  $count++;   
if ($count <= $third){ print "<tr><td>$mod2</td></tr>"; } }
print "</table></td></tr></table></body></html>";exit;

sub wanted { $count = 0; 
if ($File::Find::name =~ /\.pm$/) { 
open(MODFILE,$File::Find::name) || return;  
while(<MODFILE>) {
if (/^ *package +(\S+);/) { push (@foundmods, $1);  last; } } } }