#!/usr/bin/perl -w 
######################################################################
+##
#
# Author: Peter L. Berghold, Schooner Technology Consulting
#         peter@berghold.net
#
# Purpose: This script is run as a CGI on a new system that I am 
#    going to be developing CGI scripts on and tells me what I'm 
#    getting into before I start coding and lets me know if there 
#    are issues I need to resolve before I can start.
#
# Disclaimer: This code is not to be left in a production environment
#   because of potentially harmfull information leaks it can provide 
#   to a potential hacker or other ne'er-do-well that deserves to be
#   horsewhipped in a public place and televised on international 
#   TV.
#
#  The author and Schooner Technology Consulting do not warrantee
#  any sort of merchantilability or worthiness of this code for other
#  than the purposes stated already. There is no warranty expressed 
#  or implied for the support of this script and inquiries for same
#  will be met with cold disdain at the best. 
#
#  Lastly this code is not to be used for anything where its failure
#  could present a danger to human or other life. Schooner Techology
#  Consulting and the author are not to be held liable if this code
#  causes harm, loss of revenue, war, crime sprees or the Internationa
+l
#  Space Station to fall from the sky.
#
#  This code is hereby released into the public domain for non-commerc
+ial
#  use.
#
# -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+-=-
#
# Installation instructions:
#
#   UNIX:
#         Store this file in your CGI (cgi-bin) directory
#         Set the permissions of the file to be executable 
#               chmod 755 SysconfigCheck.pl
#
#        If this code does not run after following the instructions
#        above I would start to suspect your CGI environment is 
#        crippled beyond belief.
#
#
#   Windows:
#           Good luck.
#
# -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+-=-
$|=1;
use strict;
use CGI qw/ :all /;
use CGI::Carp qw/ fatalsToBrowser /;

#
# Put modules you want to check for their existance here... hopefully
# all the above exist. 
#
# This list changes frequently depending on the requirements I have 
# when I work in a new CGI environment
#
my @modules=qw / CGI::Cookie Spreadsheet::WriteExcel DBIx::Recordset
Net::SMTP HTML::Calendar::Simple HTML::TableLayout MIME::Lite
Mail::Send Mail::Sendmail CGI::EZForm CGI::FormBuilder GD CGI::Graph
XML::Parser
/;

#
# Instantiate CGI
my $q=new CGI;

#
# This is the order of checks that we are performing


print header;
print start_html(
         -title => 'CGI Environment Assessment'
        );

print h1('CGI Environment Assessment');

perl_info();
print hr,"\n";
env_test();
print hr,"\n";
cgi_parm_test($q);
print hr,"\n";
dbi_test();
print hr,"\n";
module_inventory(@modules);
print hr,"\n";

print end_html;

exit(0);

sub perl_info {
  print h2('Perl interpreter information');
  print p(sprintf("Perl interpreter version %s",get_perl_version()));
  print p("\@INC contains:",
      ul(ul(
        ul(
           map { li($_) } @INC
          )
           ))
     );
}

sub env_test {
  print h2('Base Account (shell) Environment');
  print table(
          map { Tr(td($_),td($ENV{$_})) } sort keys %ENV
         );
  print p(b('CGI Runs As:'),`id`);
  print p("I was invoked as: ",$0);
  if ($ENV{HOME}) {
    if (-d $ENV{HOME} . '/cgi-bin') {
      print p('Found the cgi-bin directory in ', $ENV{HOME} . "/cgi-bi
+n");
    } else {
      print p("I have no clue where the cgi-bin is physically");
    }
  } else {
    print p(b('OH DRAT!'),'The $HOME variable is not being set!');
  }
}

sub cgi_parm_test {
  my $q=shift;
  print h2("Default CGI Information");
  print table(
          map { Tr(td($_),td($q->param($_)) ) } sort $q->param
         ),"\n";
}

sub dbi_test {
  print h2('DBI Environment');
  eval ' use DBI; ';
  if ($@) {
    print p("No DBI on this machine.");
  } else {
    my @sources=DBI->available_drivers;
    print p("DBD Drivers available:",
        ul(ul(ul(
             map { li($_)} @sources
            )))
       );
  }
}

sub module_inventory {
  my @list2check=@_;

  print h2('Module Inventory');

  print table(
          map {
        Tr ( td($_),td(attempt2load($_)) )
          }sort @list2check
         );
}

sub attempt2load {
  my $module=shift;

  eval " use $module; " ;
  return ($@ ? "Not Available" : "OK" );
}

#
# Sigh!  I had to add this due to the fact that some web servers
# use antique versions of perl that don't seem to understand $^V
# nor do the understand the %vd printf format modifier.

sub get_perl_version {
  open F,"perl -v|"
    or die "Could not run perl -v: $!";
  while (my $line=<F>) {
    chomp $line;
    next unless $line =~ m@^.*\s+version\s+([\d+\.\_\-]+)\s+.*$@;
    return $1;
  }
}
[download]