forum/hostinfo

   1 #!/usr/bin/perl
   2 use Cwd;
   3 use strict;
   4 use CGI;
   5 use CGI::Carp qw(fatalsToBrowser);
   6
   7 #
   8 # List of modules, required direcrty by your application
   9 #
  10 my @modules=qw(MIME::Lite Image::Size HTML::TreeBuilder
  11 POSIX Storable HTML::BBReverse Fcntl Date::Parse
  12 LWP::UserAgent Net::OpenID::Consumer);
  13
  14 #
  15 # This array have to be filled manually by looking into Makefile.PL:
  16 # of neccessary CPAN modules and copying contents of PREREQ_PM argument
  17 # of it. Of course, recursively.
  18 #
  19 my %prereq=(
  20         "Net::OpenID::Consumer" => {
  21                    'LWP::UserAgent' => 0,
  22                    'HTTP::Request'  => 0,
  23                    'MIME::Base64'   => 0,
  24                    'Digest::SHA1'   => 0,
  25                    'URI'            => 0,
  26                    'Time::Local'    => 0,
  27                    'URI::Fetch'     => 0.02,
  28                    'Crypt::DH'      => 0.05,
  29                 },
  30          "HTML::TreeBuilder" => {
  31                 "HTML::Parser" => 2.19,
  32                 'HTML::Tagset' => 3.02,
  33           },
  34         'URI::Fetch' => {
  35                         'Class::ErrorHandler' =>0,
  36                         'LWP'=>0,
  37                         'URI'=>0,
  38                         'Storable'=>0,
  39         },
  40         'URI' => {
  41                 'MIME::Base64' => 2,
  42                 },
  43                 'Crypt::DH' => {
  44                         'Math::BigInt' =>0,
  45                 }
  46
  47         );
  48 my %modver;
  49
  50 my $cgi= new CGI;
  51 print $cgi->header(-type=>'text/html',-charset=>'windows-1251'),
  52         $cgi->start_html(-title=>'Hosting information');
  53
  54 print $cgi->h1("Hosting information");
  55 print $cgi->h2("Perl information");
  56 print "Perl version:",$cgi->escapeHTML($]),"<br>\n";
  57 print "\@INC:",$cgi->escapeHTML(join(" ",@INC)),"<br>\n";
  58 print "CGI.pm version: $CGI::VERSION<br>";
  59 print $cgi->h2("Required modules");
  60 my ($module,$ver);
  61 for $module (@modules) {
  62         if (exists $modver{$module}) {
  63                 $ver = $modver{$module}
  64         } else {
  65                 eval "use $module; \$ver=\$${module}::VERSION;";
  66                 if ($@) {
  67                         print "$module : <font color=\"red\">not found</font><br>";
  68                         if (exists $prereq{$module}) {
  69                                 scan_prereq($module);
  70                         }
  71                         next;
  72                 }
  73                 $modver{$module} = $ver;
  74         }
  75         print "$module: $ver<br>";
  76 }
  77
  78 print $cgi->h2("Execution environment"),"\n";
  79
  80 print "Script execution directory: <tt>",getcwd,"</tt><br>\n";
  81 print "Invoking user id ",$(+0," name(getpwuid) <tt>".(getpwuid($())[0]."</tt><br>\n";
  82 print "User home directory (getpwuid): <tt>".(getpwuid($())[7]."</tt><br>\n";
  83 print "User home directory(environment): <tt>",$ENV{'HOME'},"</tt><br>\n";
  84 print "Script name (\$0): <tt>$0</tt><br>\n";
  85 print "Script filename (from <b>SCRIPT_FILENAME</b> env var)
  86 <tt>$ENV{'SCRIPT_FILENAME'}</tt.<br>\n";
  87 print "Document root: <tt>$ENV{'DOCUMENT_ROOT'}</tt><br>\n";
  88 print "<b>LANG</b>: <tt>$ENV{LANG}</tt><br>\n";
  89 print "<b>SERVER_ADDR</b>: <tt>$ENV{SERVER_ADDR}</tt><br>\n";
  90 print "<b>PATH</b>: $ENV{'PATH'}<br>\n";
  91 eval {
  92  use POSIX;
  93  my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
  94  print "System: $sysname $release $version (from POSIX::uname)<br>\n";
  95 };
  96 if ($@) {
  97         print "System: `uname -a` (from OS uname command)<br>\n";
  98 }
  99 sub scan_prereq {
 100         my $module = shift;
 101         print "<br><b>Prerequistes for $module</b>:<br><blockquote>\n";
 102         my $ver;
 103         MODULE:
 104         while (my ($mod,$needed_ver) = each %{$prereq{$module}}) {
 105                 if (exists $modver{$module}) {
 106                         $ver = $modver{$module};
 107                 } else {
 108                         eval "use $mod; \$ver=\$${mod}::VERSION;";
 109                         if ($@) {
 110                                 print "$mod : <font color=\"red\">not found</font><br>";
 111                                 if (exists $prereq{$mod}) {
 112                                         scan_prereq($mod);
 113                                 }
 114                                 next MODULE;
 115                         }
 116                         $modver{$mod} = $ver;
 117                 }
 118                 if ($ver < $needed_ver) {
 119                         print "$mod: <font color=\"red\">$ver</font> (need $needed_ver<br>\n";
 120                 } else {
 121                         print "$mod: $ver<br>\n";
 122                 }
 123         }
 124         print "</blockquote>\n";
 125 }
 126