#!/usr/bin/perl
#!C:\perl\bin\perl.exe
=Copyright Infomation
==========================================================
    Program Name    : Mewsoft Search Engine
    Program Version : 4.00
    Program Author   : Elsheshtawy, A. A.
    Home Page          : http://www.mewsoft.com
	Copyrights © 2001-2002 Mewsoft. All rights reserved.
==========================================================
=cut
#==========================================================
print "Content-Type: text/html\n\n";
# Unbuffer Output
$| = 1;
print &Get_Server_Test;
exit 0;
#==========================================================
sub Get_Sys_OS{ 

	$OS = $^O;
	if (($OS eq "MSWin32") || ($OS eq "Windows_NT") || ($OS =~ /win/i)) {
			$OS = "WINNT"; 
	}
	else { 
		$OS = "UNIX"; 
	}
	return $OS;
}
#==========================================================
sub Get_Perl_Path{
my ($Out, $Outs);

	$OS = &Get_Sys_OS;
					
	if ($OS =~ m/unix/i) {
		$Outs=qq!<TABLE  width="100%" border="1" cellspacing="0" cellpadding="2" bordercolor="#E7E7CF">!;

		$Out=`which perl`;
		@Path = split(" ", $Out);
		$Out = join("<br>", @Path);

		$Outs.=qq!<tr><td width="30%"><b>Perl Path (which perl): </b> </td><td><font color=blue>$Out</font><BR>\n</td></tr>!;
		$Out=`whereis perl`;

		@Path = split(" ", $Out);
		$Out = join("<br>", @Path);
		$Outs.=qq!<tr><td  width="30%"><b>Perl Path(whereis perl): </b></td><td> <font color=blue>$Out</font><BR>\n</td></tr>!;

		$Out=`which sendmail`;
		@Path = split(" ", $Out);
		$Out = join("<br>", @Path);
		$Outs.=qq!<tr><td width="30%"><b>Sendmail Location(which sendmail): </b></td><td> <font color=blue>$Out</font><BR>\n<td></tr>!;

		$Out=`whereis sendmail`;
		@Path = split(" ", $Out);
		$Out = join("<br>", @Path);
		$Outs.=qq!<tr><td width="30%"><b>Sendmail Location(whereis sendmail): </b></td><td> <font color=blue>$Out</font><BR>\n</td></tr>!;
		$Outs.=qq!</table>!;
	}
	else{
		$Outs="Windows System, can't  detemine perl  and sendmail path...!"
	}

	return ($Outs);
} 
#==========================================================
sub OS_Version{
my ($Out, $OS_Info);

	$OS = &Get_Sys_OS;
	if ($OS =~ m/unix/i) {
			$OS_Info = `uname -a`;
	}

	$Out = qq!<TABLE  width="100%" border="1" cellspacing="0" cellpadding="2" bordercolor="#E7E7CF">!;
	$Out .= qq!<TR><TD width="30%">Perl Version:<td> $]</td></tr>\n!;
	$Out .= qq!<TR><TD width="30%">Server Operating System:</td><td>$^O:&nbsp;<font color=\"blue\">$OS_Info</font><BR>\n</td></tr>!;
	$Out .=qq!</table>!;
	return $Out;

}
#==========================================================
sub SQL_Drivers{
my (@drivers, $Out);

	eval "use DBI";
	if ($@) { return "SQL Drivers: None!!";}
	$Out = qq!<TABLE  width="100%" border="1" cellspacing="0" cellpadding="2" bordercolor="#E7E7CF">!;
	@drivers= DBI->available_drivers();# or $Out.="No drivers found!\n<br>";
	foreach my $driver (@drivers) {
			$Out.=qq!<tr><td nowrap width="30%"> Driver <u><b>$driver</b></u>\n</td><td><font color="blue">Installed</font><br></td></tr>!;
			#my @dataSources = DBI->data_sources($driver);
			foreach my $dataSource (@dataSources ) {
				#	$Out.= "\tData Source is $dataSource\n<br>";
			}
			#$Out.="\n<br>";
	}
	$Out.=qq!</table>!;
	return $Out;
}
#==========================================================
sub Module_Test {
my ($Out, $Module, $Modules, @Modules);

   @Modules = (	"File::Copy", "DBI", "DBD::mysql", "Cwd", "GD", "Net::SMTP", "LWP::Simple", "LWP::UserAgent", 
							"Archive::Zip", "constant", "Crypt::SSLeay", "Time::Local", "HTML::LinkExtor", "URI::URL", "HTML::Parser",
							"HTML::Entities", "HTML::HeadParser", "CGI::Carp", "Carp::Heavy", "LWP::UserAgent", 
							"Business::OnlinePayment", "Finance::Quote", "Finance::QuoteHist"
							);
	
	$Modules = "";
	foreach $Module (@Modules) {
			eval "use $Module;";
			($Name, $Arg) = split (/\s+/, $Module);
			$Name ||= $Module;
			if ($@) {
					$Modules .= qq!<TR><TD NOWRAP width="30%">$Name</td><td><font color="red">Not Installed</font><BR>\n</td></tr>!;
			}
			else{
					$Modules .= qq!<TR><TD NOWRAP width="30%">$Name</td><td><font color="blue">Installed</font><BR>\n</td></tr>!;
			}
	}




$Out =<<HTML;
<table  width="100%" border="1" cellspacing="0" cellpadding="2" bordercolor="#E7E7CF">
$Modules
</table>
HTML
		return $Out;
 }
#==========================================================
sub Server_Config{
my ($Out, $key, %EN, @EN);

   @EN= sort keys %ENV;

	$Out = qq!<table width="100%" border="1" cellspacing="0" cellpadding="2" bordercolor="#E7E7CF">!;
	$Out.=qq!<tr><td nowrap width="30%"><font color="red" size =3><b>Variable</b></font></td><td><font color=red size =3><b>Value</b></font></td></tr>!;
   foreach $key(@EN) {
			$Out .= qq!<tr><td nowrap width="30%"><font color=blue>  $key:</td><td></font>$ENV{$key}</td></tr>!; 
	}
	$Out .= qq!</Table>!;
	return $Out;
}
#==========================================================
sub Get_Server_Test{
my ($Out, $Out1, $Out2, $Out3, $Out4, $Modules);

	$Out1 = &Module_Test;
	$Out2 = &Server_Config;
	$Out3 = &OS_Version;
	$Out4 = &SQL_Drivers;
	$Out5 = &Get_Perl_Path;
	$Modules = &Get_Perl_Modules;

$Out=<<HTML;
			<table border="0" width="100%" cellspacing="0"  cellpadding="2" bordercolor="#E7E7CF">
			<tr><td align="center" bgcolor="#FFFFFF"><font size="4" color="red"><b>Mewsoft Server Test Tool</b></font></td></tr>
			<tr><td bgcolor="#FFCC66" ><b>Operating System and Perl Version</b></td></tr>
			<tr><td>$Out3</td></tr>
			<tr><td bgcolor="#FFCC66"><b>Perl Path and Sendmail Location</b></td></tr>
			<tr><td>$Out5</td></tr>
			<tr><td bgcolor="#FFCC66"><b>Required perl modules</b></td></tr>
			<tr><td>$Out1</td></tr>
			<tr><td bgcolor="#FFCC66"><b>DBI Installed Drivers and Data Sources</b></td></tr>
			<tr><td>$Out4</td></tr>
			<tr><td bgcolor="#FFCC66"><b>Server Environment Variables</b></td></tr>
			<tr><td>$Out2</td></tr>
			<tr><td bgcolor="#FFCC66"><b>Installed perl modules</b></td></tr>
			<tr><td>$Modules</td></tr>
			<tr><td align="center"><a href="javascript:history.go(-1)"><B>Back to the previous page</b></a></td></tr>
			<tr><td>&nbsp;</td></tr>
			<tr><td align="center">Copyright © 2000 <a href="http://www.mewsoft.com" target="_blank">Mewsoft</a>. All rights Reserved.</td></tr>
			<tr><td>&nbsp;</td></tr>
		</table>	
HTML

	return $Out;
}
#==========================================================
sub Get_Perl_Modules{
my(@Modules, $Rows, $Col, $Table, $x, $y, $Count);

	@Modules = &Get_Installed_Perl_Modules;
	@Modules = sort @Modules;
	
	$Rows = "";
	$Col = 0; $Counter = 0;
	$Count = @Modules;

	for $x(0..$Count -1){
			if ($Col == 0){$Rows .= qq!<TR>!;}
			if (!$Modules[$x]) {$Modules[$x] = "&nbsp;";}
			$Counter ++;
			$y = $Modules[$x];
			$y =~ s/^(\S+::)/\<B\>$1\<\/B\>/;
			$Rows .= qq!<TD>$Counter- $y</TD>!;
			$Col++;
			if ($Col > 2){$Rows .= qq!</TR>!; $Col = 0;}
	}

	if ($Col >0 && $Col< 3) {
			for $x($Col..2){
					$Rows .= qq!<TD>&nbsp;</TD>!;
			}
	}

	$Table = qq!<table align="center" width="100%" border="1" cellpadding="2" cellspacing="1">$Rows</table>!;

}
#==========================================================
sub Get_Installed_Perl_Modules{
my(@Modules, $Perl_Include_Dir, @Found, @Temp_Modules);

	undef @Modules;

	foreach $Perl_Include_Dir(@INC) {
			$Perl_Include_Dir =~ s/^\s//g;
			$Perl_Include_Dir =~ s/\s$//g;
			if ($Perl_Include_Dir) {
					@Found = &Scan_Directory($Perl_Include_Dir);	
					@Temp_Modules = &Filter_Perl_Modules(@Found);
					push @Modules, @Temp_Modules;
			}
	}

	return @Modules;
}
#==========================================================
sub Scan_Directory{
my($Directory)=@_;
my(@Files, %Found);

	%Found = ();
	@Files = ();
	
	my $CRLF = "\015\012"; # how lines should be terminated; "\r\n" is not correct on all systems, for instance MacPerl defines it to "\012\015"

	%Found = &Scan_Dir($Directory);

	while (($Key, $Value)= each %Found) {
			if (!$Value) {
				push @Files, $Key;
			}
	}

	return @Files;
}
#==========================================================
sub Scan_Dir{
my($Directory)=@_;
my(@Directories, @Files, %Found);
my($Current_Directory);

	undef @Directories;
	undef %Found;
	undef @Files;

	if (!$Directory) {$Directory = '.';}

	push @Directories, $Directory;
	
	while (@Directories) {
		   $Current_Directory = shift (@Directories);

		   opendir (DIR, "$Current_Directory") or return undef;# die ("Can't open $Current_Directory: $!");
		   @Files = readdir (DIR);
		   closedir (DIR);

		   foreach $File (@Files) {
					$Temp = "$Current_Directory/$File";
					  if (-d $Temp && $File ne "." && $File ne "..") {
								push @Directories, $Temp;
								$Found{$Temp} = 1;
								next;
					  }
					  else{
								if ($File ne "." && $File ne "..") {
										$Found{$Temp} = 0;
								}
					  }
			}
	}

	return %Found;
}
#==========================================================
sub Filter_Perl_Modules{
my(@Files)=@_;
my(%Modules);

	foreach $File(@Files){
		if ($File =~ m/\.pm$/){
			open(FILE, $File) or return undef;
				while(<FILE>){	
						if (/^ *package +(\S+);/){
							$Modules{$1}++;
							last;
						}
				}
		}
	}

	return keys %Modules;
}
#==========================================================
#==========================================================