#!/usr/bin/perl
#
# --------------------------------------------------------------------------
# TEST2.PL
# --------------------------------------------------------------------------
# Debug program to find out where the current working directory of Perl is.
# --------------------------------------------------------------------------
print "Content-type: text/html\n\n";
print "";
print "";
print "";
print "Survey Self-Hosting Test #2";
print "";
print "";
print "Self-Hosting Test #2
";
print "1. Runtime Environment Directories
";
print "The following is the list of paths Perl is checking for included files (\@INC):
";
print PrintEnvironmentDirectories();
print "\n
\".\" signifies the working directory.";
print "
";
print "2. Working Directory
";
print "Below is a listing of all the files in the current working directory (where this test2.pl perl script is running):
";
opendir DATADIR, "." or {Error("Error! Please ensure the Perl envrionment configurations and file permissions are set to allow perl scripts to open the directory in which perl scripts exist.")};
my @allFiles = ();
@allFiles = readdir DATADIR;
closedir DATADIR;
print join("
\n",@allFiles);
print "
";
print "3. Available Perl Modules
";
print "The table below is a list of the Perl modules that may be used by Sawtooth Software surveys.
";
print PrintAvailableModules();
print "\n\n";
# -------------------------------------------------------
sub PrintEnvironmentDirectories
{
my $astrOut = "";
my $i = 0;
for ($i = 0;$i < @INC; $i++)
{
$astrOut .= "" . ($i + 1) . ")" . $INC[$i] . "
\n";
}
$astrOut .= "
";
return $astrOut;
}
sub PrintWorkingDirectory
{
my @allFiles = ();
opendir DATADIR, "." or {Error("Error! Please ensure the Perl environment configurations and file permissions are set to allow perl scripts to open the directory in which perl scripts exist.")};
@allFiles = readdir DATADIR;
closedir DATADIR;
my $strOut = join("
\n",@allFiles);
return $strOut;
}
sub PrintAvailableModules
{
my $strCode = "";
my $strOut = "| Module Name | Working? | Installed Version | Notes |
|---|
";
$strOut .= "" . PrintCells("DBI") . "| This Module is required for all Sawtooth Software Surveys. |
";
$strOut .= "" . PrintCells("DBD::mysql") . "| This Module is required for running surveys that will connect to a MySQL or MariaDB database. |
";
$strOut .= "" . PrintCells("DBD::ODBC") . "| This Module is required for running surveys that will connect to a Microsoft SQL Server database. |
";
$strOut .= "" . PrintCells("JSON") . "| This Module is required for running surveys built with Lighthouse Studio 9.10 or later. |
";
$strOut .= "" . PrintCells("DateTime") . "| This Module is optional. It allows for better formatting of time stamps in the Admin Module. |
";
$strOut .= "
";
return $strOut;
}
sub PrintCells
{
my $strModuleName = $_[0];
$strCode = "require " . $strModuleName;
eval $strCode;
my $strOut .= "" . $strModuleName . " | ";
if ($strModuleName->VERSION)
{
$strOut .= "✔ | ";
$strOut .= "" . $strModuleName->VERSION . " | ";
}
else
{
$strOut .= "✖ | ";
$strOut .= "- | ";
}
return $strOut;
}
sub Error
{
my ($strMsg) = @_;
print "\n
" . $strMsg . "
\n";
exit;
}