#!/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 HTML::BBReverse Fcntl Date::Parse
LWP::UserAgent Net::OpenID::Consumer);
#
# 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' => {
'MIME::Base64' => 2,
},
'Crypt::DH' => {
'Math::BigInt' =>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($]),"
\n";
print "\@INC:",$cgi->escapeHTML(join(" ",@INC)),"
\n";
print "CGI.pm version: $CGI::VERSION
";
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 : not found
";
if (exists $prereq{$module}) {
scan_prereq($module);
}
next;
}
$modver{$module} = $ver;
}
print "$module: $ver
";
}
print $cgi->h2("Execution environment"),"\n";
print "Script execution directory: ",getcwd,"
\n";
print "Invoking user id ",$(+0," name(getpwuid) ".(getpwuid($())[0]."
\n";
print "User home directory (getpwuid): ".(getpwuid($())[7]."
\n";
print "User home directory(environment): ",$ENV{'HOME'},"
\n";
print "Script name (\$0): $0
\n";
print "Script filename (from SCRIPT_FILENAME env var)
$ENV{'SCRIPT_FILENAME'}\n";
print "Document root: $ENV{'DOCUMENT_ROOT'}
\n";
print "LANG: $ENV{LANG}
\n";
print "SERVER_ADDR: $ENV{SERVER_ADDR}
\n";
print "PATH: $ENV{'PATH'}
\n";
eval {
use POSIX;
my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
print "System: $sysname $release $version (from POSIX::uname)
\n";
};
if ($@) {
print "System: `uname -a` (from OS uname command)
\n";
}
sub scan_prereq {
my $module = shift;
print "
Prerequistes for $module:
\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 : not found
";
if (exists $prereq{$mod}) {
scan_prereq($mod);
}
next MODULE;
}
$modver{$mod} = $ver;
}
if ($ver < $needed_ver) {
print "$mod: $ver (need $needed_ver
\n";
} else {
print "$mod: $ver
\n";
}
}
print "
\n";
}