#!/usr/bin/env perl #------------------------------------------------------------------- # WebGUI is Copyright 2001-2009 Plain Black Corporation. #------------------------------------------------------------------- # Please read the legal notices (docs/legal.txt) and the license # (docs/license.txt) that came with this distribution before using # this software. #------------------------------------------------------------------- # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- use strict; use File::Basename (); use File::Spec; my $webguiRoot; BEGIN { $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } use CPAN; use Getopt::Long; use Pod::Usage; use Cwd (); my ($os, $prereq, $dbi, $dbDrivers, $simpleReport, $help, $noprompt); GetOptions( 'noprompt' => \$noprompt, 'simpleReport'=>\$simpleReport, 'help'=>\$help, ); pod2usage( verbose => 2 ) if $help; print "\nWebGUI is checking your system environment:\n\n"; $prereq = 1; printTest("Operating System"); printResult(getOs()); printTest("WebGUI Root"); printResult($webguiRoot); ################################### # Checking Perl ################################### printTest("Perl Interpreter"); if ($] >= 5.008009) { printResult("OK"); } else { failAndExit("Please upgrade to 5.8.9 or later! Cannot continue without Perl 5.8.9 or higher."); } ##Doing this as a global is not nice, but it works my $missingModule = 0; checkModule("LWP", 5.833 ); checkModule("HTML::Form", 5.800, 2 ); checkModule("Net::DNS", 0.66, ); checkModule("Try::Tiny", 0.07, ); checkModule("HTTP::Request", 1.40 ); checkModule("HTTP::Headers", 1.61 ); checkModule("Test::More", 0.96, 2 ); checkModule("Test::MockObject", 1.02, 2 ); checkModule("Test::Deep", 0.095, ); checkModule("Test::LongString", 0.13, 2 ); checkModule("Test::Exception", 0.27, 2 ); checkModule("Test::Differences", 0.5, 2 ); checkModule("Test::Class", 0.31, 2 ); checkModule("Test::MockTime", 0.09, 2 ); checkModule("Pod::Coverage", 0.19, 2 ); checkModule("Text::Balanced", 2.00, 2 ); checkModule("Digest::MD5", 2.38 ); checkModule("DBI", 1.607 ); checkModule("DBD::mysql", 4.010 ); checkModule("HTML::Parser", 3.60 ); checkModule("Archive::Tar", 1.44 ); checkModule("Archive::Zip", 1.26 ); checkModule("IO::Zlib", 1.09 ); checkModule("Compress::Zlib", 2.015 ); checkModule("Net::SMTP", 2.31 ); checkModule("MIME::Tools", 5.427 ); checkModule("Net::POP3", 2.29 ); checkModule("Tie::IxHash", 1.21 ); checkModule("Tie::CPHash", 1.04 ); checkModule("XML::Simple", 2.18 ); checkModule("DateTime", 0.4501 ); checkModule("Time::HiRes", 1.9719 ); checkModule("DateTime::Format::Strptime", 1.0800 ); checkModule("DateTime::Format::Mail", 0.3001 ); checkModule("DateTime::Format::HTTP", 0.38 ); checkModule("Image::Magick", "6.0" ); checkModule("Log::Log4perl", 1.20 ); checkModule("Net::LDAP", 0.39 ); checkModule("HTML::Highlight", 0.20 ); checkModule("HTML::TagFilter", 1.03 ); checkModule("HTML::Template", 2.9 ); checkModule("HTML::Template::Expr", 0.07, 2 ); checkModule("Template", 2.20, 2 ); checkModule("XML::FeedPP", 0.40 ); checkModule("XML::FeedPP::MediaRSS", 0.02 ); checkModule("JSON", 2.12 ); checkModule("JSON::PP", 0.00 ); checkModule("Config::JSON", "1.3.1" ); checkModule("Text::CSV_XS", "0.64" ); checkModule("Net::CIDR::Lite", 0.20 ); checkModule("Finance::Quote", 1.15 ); checkModule("POE", 1.005 ); checkModule("POE::Component::IKC::Server", 0.2001 ); checkModule("POE::Component::Client::HTTP", 0.88 ); checkModule("Apache2::Request", 2.08 ); checkModule("URI::Escape", "3.29" ); checkModule("POSIX" ); checkModule("List::Util" ); checkModule("Color::Calc" ); checkModule("Text::Aspell", 0.01,2 ); checkModule("Weather::Com::Finder", "0.5.3" ); checkModule("Class::InsideOut", "1.09" ); checkModule("HTML::TagCloud", "0.34" ); checkModule("Image::ExifTool", "7.67" ); checkModule("Archive::Any", "0.0932" ); checkModule("Path::Class", '0.16' ); checkModule("Exception::Class", "1.26" ); checkModule("List::MoreUtils", "0.22" ); checkModule("File::Path", "2.07" ); checkModule("Module::Find", "0.06" ); checkModule("Class::C3", "0.21" ); checkModule("Params::Validate", "0.91" ); checkModule('JavaScript::Packer', '1.002' ); checkModule('CSS::Packer', '1.000' ); checkModule('HTML::Packer', "1.000" ); checkModule('Business::Tax::VAT::Validation', '0.20' ); #checkModule('Crypt::SSLeay', '0.57' ); checkModule('Scope::Guard', '0.20' ); checkModule('Digest::SHA', '5.47' ); checkModule("CSS::Minifier::XS", "0.03" ); checkModule("JavaScript::Minifier::XS", "0.05" ); checkModule("Readonly", "1.03" ); checkModule("Business::PayPal::API", "0.62" ); checkModule("Business::OnlinePayment", "3.01" ); checkModule("Business::OnlinePayment::AuthorizeNet", "3.22" ); checkModule("Locales", "0.10" ); checkModule("Test::Harness", "3.17" ); checkModule("DateTime::Event::ICal", "0.10" ); checkModule("Cache::FastMmap", "1.35" ); checkModule("Test::Tester", "0" ); checkModule("Test::Log::Dispatch", "0" ); checkModule("CHI", "0.34" ); checkModule('IO::Socket::SSL', ); checkModule('Net::Twitter', "3.13006" ); checkModule('PerlIO::eol', "0.14" ); checkModule('Monkey::Patch', '0.03' ); checkModule('Kwargs', ); checkModule('Data::ICal', '0.16' ); checkModule('common::sense', '3.2' ); checkModule('Geo::Coder::Googlev3', '0.07' ); checkModule('Storable', '2.00' ); failAndExit("Required modules are missing, running no more checks.") if $missingModule; ################################### # Checking WebGUI ################################### printTest("WebGUI modules"); if (eval { require WebGUI } && eval { require WebGUI::SQL } && eval { require WebGUI::Config }) { printResult("OK"); } else { failAndExit("Not Found. Perhaps you're running this script from the wrong place."); } ################################### # Checking Version ################################### my $version = getLatestWebguiVersion(); printTest("Your version"); if ($version eq $WebGUI::VERSION."-".$WebGUI::STATUS) { printResult("You are using the latest version - $WebGUI::VERSION-$WebGUI::STATUS"); } else { printResult("You are using ".$WebGUI::VERSION."-".$WebGUI::STATUS." and ".$version." is available."); } printTest("Locating WebGUI configs"); my $configs = WebGUI::Config->readAllConfigs($webguiRoot); printResult("OK"); foreach my $filename (keys %{$configs}) { print "\n"; ################################### # Checking Config File ################################### printTest("Checking config file"); printResult($filename); ################################### # Checking uploads folder ################################### printTest("Verifying uploads folder"); if (opendir(DIR,$configs->{$filename}->get("uploadsPath"))) { printResult("OK"); closedir(DIR); } else { printResult("Appears to be missing!"); } printTest("Verifying DSN"); my $dsnok = 0; if ($configs->{$filename}->get("dsn") !~ /\DBI\:\w+\:\w+/) { printResult("DSN is improperly formatted."); } else { printResult("OK"); $dsnok = 1; } ################################### # Checking database ################################### if ($dsnok) { printTest("Verifying database connection"); my ($dbh, $test); unless (eval {$dbh = DBI->connect($configs->{$filename}->get("dsn"),$configs->{$filename}->get("dbuser"),$configs->{$filename}->get("dbpass"))}) { printResult("Can't connect with info provided!"); } else { printResult("OK"); $dbh->disconnect(); } } } print "\nTesting complete!\n\n"; #---------------------------------------- sub checkModule { my $module = shift; my $version = shift || 0; my $skipInstall = shift; my $afterinstall = shift; unless (defined $afterinstall) { $afterinstall = 0; } printTest("Checking for module $module"); my $statement = "require ".$module.";"; # we tried installing, now what? if ($afterinstall == 1) { failAndExit("Install of $module failed!") unless eval($statement); # //todo: maybe need to check new install module version printResult("OK"); return; } # let's see if the module is installed elsif (eval($statement)) { $statement = '$'.$module."::VERSION"; my $currentVersion = eval($statement); # is it the correct version if ($currentVersion >= $version) { printResult("OK"); } # not the correct version, now what? else { # do nothing we're just reporting the modules. if ($simpleReport) { printResult("Outdated - Current: ".$currentVersion." / Required: ".$version); } # do nothing, this module isn't required elsif ( $skipInstall == 2 ) { printResult("Outdated - Current: ".$currentVersion." / Required: ".$version.", but it's optional anyway"); } # if we're an admin let's offer to install it elsif (isRootRequirementMet()) { my $installThisModule = defined $noprompt ? "y" : "n"; if ( $installThisModule eq "n" ) { $installThisModule = prompt ("$currentVersion is installed, but we need at least " . "$version, do you want to upgrade it now?", "y", "y", "n"); } # does the user wish to install it if ($installThisModule eq "y") { installModule($module); checkModule($module,$version,$skipInstall,1); } # user doesn't wish to install it else { printResult("Upgrade aborted by user input."); } } # we're not root so lets skip it else { printResult("Outdated - Current: ".$currentVersion." / Required: ".$version .", but you're not root, so you need to ask your administrator to upgrade it."); } } # module isn't installed, now what? } else { # skip optional module if ($skipInstall == 2) { printResult("Not Installed, but it's optional anyway"); } # skip elsif ($simpleReport) { printResult("Not Installed"); $missingModule = 1; } # if we're root lets try and install it elsif ( isRootRequirementMet()) { my $installThisModule = defined $noprompt ? "y" : "n"; if ( $installThisModule eq "n" ) { $installThisModule = prompt ("Not installed, do you want to install it now?", "y", "y", "n" ); } # user wishes to upgrade if ($installThisModule eq "y") { installModule($module); checkModule($module,$version,$skipInstall,1); } # install aborted by user else { printResult("Install aborted by user input."); $missingModule = 1; } } # can't install, not root else { printResult("Not installed, but you're not root, so you need to ask your administrator to install it."); $missingModule = 1; } } } #---------------------------------------- sub failAndExit { my $exitmessage = shift; print $exitmessage."\n\n"; exit; } #---------------------------------------- sub getLatestWebguiVersion { printTest("Getting current WebGUI version"); my $currentversionUserAgent = new LWP::UserAgent; $currentversionUserAgent->env_proxy; $currentversionUserAgent->agent("WebGUI-Check/2.1"); $currentversionUserAgent->timeout(30); $currentversionUserAgent->env_proxy(); my $header = new HTTP::Headers; my $referer = "http://".`hostname`."/webgui-cli-version"; chomp $referer; $header->referer($referer); my $currentversionRequest = new HTTP::Request (GET => "http://update.webgui.org/latest-version.txt", $header); my $currentversionResponse = $currentversionUserAgent->request($currentversionRequest); my $version = $currentversionResponse->content; chomp $version; if ($currentversionResponse->is_error || $version eq "") { printResult("Failed! Continuing without it."); } else { printResult("OK"); } return $version; } #---------------------------------------- sub getOs { if ($^O =~ /MSWin32/i || $^O =~ /^Win/i) { return "Windowsish"; } return "Linuxish"; } #---------------------------------------- sub installModule { my $module = shift; print "Attempting to install ".$module."...\n"; my $cwd = Cwd::cwd; CPAN::Shell->install($module); chdir $cwd; } #---------------------------------------- sub isIn { my $key = shift; $_ eq $key and return 1 for @_; return 0; } #---------------------------------------- sub isRootRequirementMet { if (getOs() eq "Linuxish") { return ($< == 0); } else { return 1; } } #---------------------------------------- sub printTest { my $test = shift; print sprintf("%-50s", $test.": "); } #---------------------------------------- sub printResult { my $result = shift; print "$result\n"; } #---------------------------------------- sub prompt { my $question = shift; my $default = shift; my @answers = @_; # the rest are answers print "\n".$question." "; print "{".join("|",@answers)."} " if ($#answers > 0); print "[".$default."] " if (defined $default); my $answer = ; chomp $answer; $answer = $default if ($answer eq ""); $answer = prompt($question,$default,@answers) if (($#answers > 0 && !(isIn($answer,@answers))) || $answer eq ""); return $answer; } __END__ =head1 NAME testEnvironment - Test Perl environment for proper WebGUI support. =head1 SYNOPSIS testEnvironment --simpleReport testEnvironment --help =head1 DESCRIPTION This WebGUI utility script tests the current Perl environment to make sure all of WebGUI's dependencies are satisfied. It also checks for proper installation of WebGUI's libraries. If any of the required Perl modules is not available or outdated, the script will ask if it should attempt installation using CPAN. This will only be possible if the script is being run as a superuser. The script will attempt to find out the latest available version from L, and compare with the currently installed one. =over =item B<--simpleReport> Prints the status report to standard output, but does not attempt to upgrade any outdated or missing Perl modules. =item B<--help> Shows this documentation, then exits. =back =head1 AUTHOR Copyright 2001-2009 Plain Black Corporation. =cut