8ae16ba37c
Squashed commit of the following:
commit ce957db5311c7fb11c7d780b9f63c1b0adc17cda
Author: Colin Kuskie <colink@perldreamer.com>
Date: Mon Jan 31 19:00:23 2011 -0800
Changelog notice for the ical bugfix with timezones.
commit 24a3bc1c74b20ca6ba689641fa0187b659dc3c5e
Author: Colin Kuskie <colink@perldreamer.com>
Date: Mon Jan 31 15:32:50 2011 -0800
Transfer the time zone as one of the WebGUI specific items for the Event.
commit 36f87539ba8b090a5e5c9f1879cd40b6f6e69afc
Author: Colin Kuskie <colink@perldreamer.com>
Date: Sun Jan 30 21:18:12 2011 -0800
Refactor the code so that the Event adds itself to a calendar object, giving it access to add other things to the calendar, like a timezone definition.
commit f401966bd53b51950f1402a5a19b92b13dcc6b06
Author: Colin Kuskie <colink@perldreamer.com>
Date: Sun Jan 30 19:42:49 2011 -0800
Document which version of Data::ICal that we're now using.
commit 689522e30b26fc445da5b59b81789c0d72e157d4
Author: Colin Kuskie <colink@perldreamer.com>
Date: Sat Jan 29 14:27:25 2011 -0800
Fix a typo in the Event preventing menuTitle from being sent out. Fix issue with the menuTitle being set twice. Update the test to fix long string handling.
commit 59043eee1536e60d92f23313a33dc54da6f15122
Author: Colin Kuskie <colink@perldreamer.com>
Date: Fri Jan 28 19:48:16 2011 -0800
Move iCal generation over to Data::ICal. Give each event the ability to return itself as an Data::ICal::Entry::Event object.
commit eec448b38c101b599c0fb695f442012e311385fb
Author: Colin Kuskie <colink@perldreamer.com>
Date: Fri Jan 28 19:47:14 2011 -0800
Document new testing module. It't only required if you're doing testing.
commit 3d1e82229423834330dcdd31c0a81df986df0f32
Author: Colin Kuskie <colink@perldreamer.com>
Date: Fri Jan 28 17:05:09 2011 -0800
Fix setting the title in the iCal feed.
commit 458f4d2e0e1faa1cc6dcb7107040d06b51b97d36
Author: Colin Kuskie <colink@perldreamer.com>
Date: Fri Jan 28 13:37:52 2011 -0800
Rewrite of CalendarUpdateFeeds to use Data::ICal
commit 1a271ebc78bbe8b21a26f7a0dba61d1462922f30
Author: Colin Kuskie <colink@perldreamer.com>
Date: Fri Jan 28 10:49:27 2011 -0800
Begin building an ICal object for parsing the ical feeds.
479 lines
16 KiB
Perl
Executable file
479 lines
16 KiB
Perl
Executable file
#!/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.008) {
|
|
printResult("OK");
|
|
} else {
|
|
failAndExit("Please upgrade to 5.8 or later! Cannot continue without Perl 5.8 or higher.");
|
|
}
|
|
|
|
##Doing this as a global is not nice, but it works
|
|
my $missingModule = 0;
|
|
|
|
checkModule("LWP", 5.833 );
|
|
checkModule("HTTP::Request", 1.40 );
|
|
checkModule("HTTP::Headers", 1.61 );
|
|
checkModule("Test::More", 0.82, 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("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("JSON", 2.12 );
|
|
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("Clone", "0.31" );
|
|
checkModule('HTML::Packer', "0.4" );
|
|
checkModule('JavaScript::Packer', '0.04' );
|
|
checkModule('CSS::Packer', '0.2' );
|
|
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("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('Data::ICal', '0.16' );
|
|
|
|
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 = <STDIN>;
|
|
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<http://update.webgui.org>, 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
|