#!/usr/bin/perl
use Cwd;
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

#
# List of modules, required direcrty by your application
#
my @modules=qw(MIME::Lite Image::Size HTML::TreeBuilder
POSIX Storable Fcntl Date::Parse
LWP::UserAgent Net::OpenID::Consumer Email::Valid);

#
# This array have to be filled manually by looking into Makefile.PL:
# of neccessary CPAN modules and copying contents of PREREQ_PM argument
# of it. Of course, recursively.
#
my %prereq=(
	"Net::OpenID::Consumer" => {
                   'LWP::UserAgent' => 0,
                   'HTTP::Request'  => 0,
                   'MIME::Base64'   => 0,
                   'Digest::SHA1'   => 0,
                   'URI'            => 0,
                   'Time::Local'    => 0,
                   'URI::Fetch'     => 0.02,
                   'Crypt::DH'      => 0.05,
		},
	 "HTML::TreeBuilder" => {
	 	"HTML::Parser" => 2.19,
		'HTML::Tagset' => 3.02,
	  },
	'URI::Fetch' => {
			'Class::ErrorHandler' =>0,
			'LWP'=>0,
			'URI'=>0,
			'Storable'=>0,
	},
	'URI::URL' => {
		'URI::Escape' => 0,
	},	
	'URI' => {
		'MIME::Base64' => 2,
		},
	'Crypt::DH' => {
		'Math::BigInt' =>0,
	},	
	'Email::Valid'=> {
		"Mail::Address"=>0,
		'File::Spec'=>0,
		'IO::File'=>0,
		'Carp'=>0,
	}	
	);
my %modver;

my $cgi= new CGI;
print $cgi->header(-type=>'text/html',-charset=>'windows-1251'),
	$cgi->start_html(-title=>'Hosting information');

print $cgi->h1("Hosting information");
print $cgi->h2("Perl information");
print "Perl version:",$cgi->escapeHTML($]),"<br>\n";
print "\@INC:",$cgi->escapeHTML(join(" ",@INC)),"<br>\n";  
print "CGI.pm version: $CGI::VERSION<br>";
print $cgi->h2("Required modules");
my ($module,$ver);
for $module (@modules) {
	if (exists $modver{$module}) {
		$ver = $modver{$module}
	} else {	
		eval "use $module; \$ver=\$${module}::VERSION;";
		if ($@) {
			print "$module : <font color=\"red\">not found</font><br>";
			if (exists $prereq{$module}) {
				scan_prereq($module);
			}
			next;	
		}
		$modver{$module} = $ver;
	}	
	print "$module: $ver<br>";
}	

print $cgi->h2("Execution environment"),"\n"; 

print "Script execution directory: <tt>",getcwd,"</tt><br>\n";
print "Invoking user id ",$(+0," name(getpwuid) <tt>".(getpwuid($())[0]."</tt><br>\n";
print "User home directory (getpwuid): <tt>".(getpwuid($())[7]."</tt><br>\n"; 
print "User home directory(environment): <tt>",$ENV{'HOME'},"</tt><br>\n";
print "Script name (\$0): <tt>$0</tt><br>\n";
print "Script filename (from <b>SCRIPT_FILENAME</b> env var)
<tt>$ENV{'SCRIPT_FILENAME'}</tt.<br>\n"; 
print "Document root: <tt>$ENV{'DOCUMENT_ROOT'}</tt><br>\n";
print "<b>LANG</b>: <tt>$ENV{LANG}</tt><br>\n";
print "<b>SERVER_ADDR</b>: <tt>$ENV{SERVER_ADDR}</tt><br>\n";
print "<b>PATH</b>: $ENV{'PATH'}<br>\n";
eval {
 use POSIX;	
 my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
 print "System: $sysname $release $version (from POSIX::uname)<br>\n";
}; 
if ($@) {
	print "System: `uname -a` (from OS uname command)<br>\n";
} 
sub scan_prereq {
	my $module = shift;
	print "<br><b>Prerequistes for $module</b>:<br><blockquote>\n";
	my $ver;
	MODULE:
	while (my ($mod,$needed_ver) = each %{$prereq{$module}}) {
		if (exists $modver{$module}) {
			$ver = $modver{$module};
		} else {	
			eval "use $mod; \$ver=\$${mod}::VERSION;";
			if ($@) {
				print "$mod : <font color=\"red\">not found</font><br>";
				if (exists $prereq{$mod}) {
					scan_prereq($mod);
				}
				next MODULE;
			}	
			$modver{$mod} = $ver;
		}	
		if ($ver < $needed_ver) {
			print "$mod: <font color=\"red\">$ver</font> (need $needed_ver<br>\n";	
		} else {	
			print "$mod: $ver<br>\n";
		}
	}
	print "</blockquote>\n";
}