Moved the offline executables to "sbin". Updated testEnvironment.pl to test all of the conf files in etc.
This commit is contained in:
JT Smith
parent
4ba70f123e
commit
2671feae26
4 changed files with 487 additions and 0 deletions
|
|
@ -7,6 +7,11 @@ upgrading from one version to the next, or even between multiple
|
|||
versions. Be sure to heed the warnings contained herein as they will
|
||||
save you many hours of grief.
|
||||
|
||||
3.9.0
|
||||
--------------------------------------------------------------------
|
||||
* The offline executables (runHourly.pl, testEnvironment.pl,
|
||||
and preload.perl) have been moved to the sbin folder.
|
||||
|
||||
3.8.0
|
||||
--------------------------------------------------------------------
|
||||
* Widgets are being replaced with Wobjects. Any custom widgets
|
||||
|
|
|
|||
36
sbin/preload.perl
Normal file
36
sbin/preload.perl
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
#! /usr/bin/perl
|
||||
use strict;
|
||||
|
||||
use lib "/data/WebGUI/lib";
|
||||
|
||||
print "Staring WebGUI ".$WebGUI::VERSION."\t\t";
|
||||
$ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl/ or die "GATEWAY_INTERFACE not Perl!";
|
||||
|
||||
use Apache::Registry ();
|
||||
use Apache::DBI ();
|
||||
use CGI (); CGI->compile(':all');
|
||||
use CGI::Carp ();
|
||||
use DBI ();
|
||||
use DBD::mysql ();
|
||||
use URI::Escape ();
|
||||
#use HTML::Parser (); # commented because it is causing problems with attachments
|
||||
use Data::Config ();
|
||||
use Date::Calc ();
|
||||
use HTML::CalendarMonthSimple ();
|
||||
eval "use Image::Magick ();"; # eval, may not be installed
|
||||
use Tie::CPHash ();
|
||||
use Tie::IxHash ();
|
||||
use Net::LDAP ();
|
||||
use Net::SMTP ();
|
||||
use File::Copy ();
|
||||
use File::Path ();
|
||||
use FileHandle ();
|
||||
#use HTML::TagFilter (); # commented because it is causing problems with attachments
|
||||
use POSIX ();
|
||||
use WebGUI ();
|
||||
|
||||
print "[ OK ]";
|
||||
|
||||
1;
|
||||
|
||||
|
||||
85
sbin/runHourly.pl
Normal file
85
sbin/runHourly.pl
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black Software.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
BEGIN {
|
||||
unshift (@INC, "../lib");
|
||||
}
|
||||
|
||||
use DBI;
|
||||
use HTTP::Request;
|
||||
use LWP::UserAgent;
|
||||
use strict;
|
||||
use Data::Config;
|
||||
use WebGUI::SQL;
|
||||
use RSSLite;
|
||||
|
||||
my $config = new Data::Config '../etc/WebGUI.conf';
|
||||
our $dbh = DBI->connect($config->param('dsn'), $config->param('dbuser'), $config->param('dbpass'));
|
||||
|
||||
deleteExpiredSessions();
|
||||
updateSyndicatedContent();
|
||||
|
||||
$dbh->disconnect();
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub deleteExpiredSessions {
|
||||
WebGUI::SQL->write("delete from userSession where expires<".time(),$dbh);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getRSS {
|
||||
my ($userAgent, $request, $response, $content, %result);
|
||||
$userAgent = new LWP::UserAgent;
|
||||
$request = new HTTP::Request (GET => $_[0]);
|
||||
$response = $userAgent->request($request);
|
||||
$content = $response->content;
|
||||
parseXML(\%result, \$content);
|
||||
return %result;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub generateHTML {
|
||||
my (%rss, $html, $item);
|
||||
%rss = @_;
|
||||
$html = $rss{title};
|
||||
$html = '<a href="'.$rss{link}.'" target="_blank">'.$html.'</a>' if ($rss{link});
|
||||
$html = '<h1>'.$html.'</h1>';
|
||||
$html .= $rss{description}.'<p>' if ($rss{description});
|
||||
foreach $item (@{$rss{items}}) {
|
||||
$html .= '<li>';
|
||||
if ($item->{link}) {
|
||||
$html .= '<a href="'.$item->{link}.'" target="_blank">'.$item->{title}.'</a>';
|
||||
} else {
|
||||
$html .= $item->{title};
|
||||
}
|
||||
$html .= ' - '.$item->{description} if ($item->{description});
|
||||
$html .= '<br>';
|
||||
}
|
||||
return ($html);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub updateSyndicatedContent {
|
||||
my ($sth, @data, %rss, $html);
|
||||
$sth = WebGUI::SQL->read("select wobject.wobjectId, SyndicatedContent.rssURL, SyndicatedContent.content from wobject,SyndicatedContent where wobject.wobjectId=SyndicatedContent.wobjectId and wobject.pageId<>3",$dbh);
|
||||
while (@data = $sth->array) {
|
||||
%rss = getRSS($data[1]);
|
||||
$html = generateHTML(%rss);
|
||||
if ($html ne "") {
|
||||
WebGUI::SQL->write("update SyndicatedContent set content=".$dbh->quote($html).", lastFetched=".time()." where wobjectId=$data[0]",$dbh);
|
||||
} elsif (substr($data[2],6) ne "Unable" && substr($data[2],7) ne "Not yet") {
|
||||
# then just leave the existing content in place
|
||||
} else {
|
||||
WebGUI::SQL->write("update SyndicatedContent set content='Unable to fetch content. Perhaps the RSS is improperly formated.', lastFetched=".time()." where wobjectId=$data[0]",$dbh);
|
||||
}
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
|
||||
361
sbin/testEnvironment.pl
Normal file
361
sbin/testEnvironment.pl
Normal file
|
|
@ -0,0 +1,361 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black Software.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
# Yeah if you're looking at this code you're probably thinking to
|
||||
# yourself, "What a #$@*ing mess!" That's what we think too. But
|
||||
# if you know Perl well enough to know that this sux, then you
|
||||
# probably don't need to use this script cuz you know how to
|
||||
# install Perl modules and such.
|
||||
|
||||
our $webguiRoot;
|
||||
|
||||
BEGIN {
|
||||
$webguiRoot = $ARGV[0] || "/data/WebGUI";
|
||||
unshift (@INC, $webguiRoot."/lib");
|
||||
}
|
||||
|
||||
use strict;
|
||||
use CPAN;
|
||||
|
||||
print "\nWebGUI is checking your system environment:\n\n";
|
||||
|
||||
my ($os, $prereq, $dbi);
|
||||
$prereq = 1;
|
||||
|
||||
if ($^O =~ /Win/i) {
|
||||
$os = "Microsoftish";
|
||||
} else {
|
||||
$os = "Linuxish";
|
||||
}
|
||||
|
||||
print "Operating System.........................".$os."\n";
|
||||
print "WebGUI Root..............................".$webguiRoot."\n";
|
||||
|
||||
###################################
|
||||
# Checking Perl
|
||||
###################################
|
||||
|
||||
print "Perl Interpreter.........................";
|
||||
if ($] >= 5.006) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Please upgrade to 5.6 or later!\n";
|
||||
print "Test environment exiting, cannot continue without Perl 5.6.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
print "LWP module...............................";
|
||||
if (eval { require LWP }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("LWP");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "HTTP::Request module.....................";
|
||||
if (eval { require HTTP::Request }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Please install LWP.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
|
||||
print "HTTP::Headers module.....................";
|
||||
if (eval { require HTTP::Headers }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Please install LWP.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
|
||||
print "Digest::MD5 module.......................";
|
||||
if (eval { require Digest::MD5 }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("Digest::MD5");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
my $dbi;
|
||||
|
||||
print "DBI module...............................";
|
||||
if (eval { require DBI }) {
|
||||
print "OK\n";
|
||||
$dbi = 1;
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("DBI");
|
||||
eval {require DBI};
|
||||
$dbi = 1;
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
$dbi = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Avalable database drivers................";
|
||||
if ($dbi) {
|
||||
print join(", ",DBI->available_drivers);
|
||||
} else {
|
||||
print "None";
|
||||
$prereq = 0;
|
||||
}
|
||||
print "\n";
|
||||
|
||||
print "HTML::Parser module......................";
|
||||
if (eval { require HTML::Parser }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("HTML::Parser");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Tie::IxHash module.......................";
|
||||
if (eval { require Tie::IxHash }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("Tie::IxHash");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Tie::CPHash module.......................";
|
||||
if (eval { require Tie::CPHash }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("Tie::CPHash");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Net::SMTP module.........................";
|
||||
if (eval { require Net::SMTP }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("Net::SMTP");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Net::LDAP module.........................";
|
||||
if (eval { require Net::LDAP }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("Net::LDAP");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Date::Calc module........................";
|
||||
if (eval { require Date::Calc }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("Date::Calc");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "HTML::CalendarMonthSimple module.........";
|
||||
if (eval { require HTML::CalendarMonthSimple }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
if ($< == 0 && $os eq "Linuxish") {
|
||||
print "Installing...\n";
|
||||
CPAN::Shell->install("HTML::CalendarMonthSimple");
|
||||
} else {
|
||||
print "Please install.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
}
|
||||
|
||||
print "Image::Magick module.....................";
|
||||
if (eval { require Image::Magick }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Please install or thumbnailing will be disabled.\n";
|
||||
}
|
||||
|
||||
print "Apache::DBI module.......................";
|
||||
if (eval { require Apache::DBI }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Please install if you want to use the mod_perl preloader.\n";
|
||||
}
|
||||
|
||||
# this is here to insure they installed correctly.
|
||||
|
||||
if ($prereq) {
|
||||
print "WebGUI modules...........................";
|
||||
if (eval { require WebGUI } && eval { require WebGUI::SQL }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Not Found. Perhaps you're running this script in the wrong place.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
|
||||
print "Data::Config module......................";
|
||||
if (eval { require Data::Config }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Not Found. Perhaps you're running this script in the wrong place.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
|
||||
print "HTML::TagFilter module...................";
|
||||
if (eval { require HTML::TagFilter }) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "Not Found. Perhaps you're running this script in the wrong place.\n";
|
||||
$prereq = 0;
|
||||
}
|
||||
} else {
|
||||
print "Cannot continue without prerequisites.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
unless ($prereq) {
|
||||
print "Cannot continue without WebGUI files.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my (@files, $file, $dir, $error);
|
||||
if ($os eq "Windowsish") {
|
||||
$dir = $webguiRoot."\\etc\\";
|
||||
} else {
|
||||
$dir = $webguiRoot."/etc/";
|
||||
}
|
||||
opendir (DIR,$dir) or $error = "Can't open etc (".$dir.") directory!";
|
||||
if ($error ne "") {
|
||||
print $error."\nCannot continue.\n";
|
||||
exit;
|
||||
} else {
|
||||
@files = readdir(DIR);
|
||||
foreach $file (@files) {
|
||||
if ($file =~ /(.*?)\.conf$/ && $file ne "some_other_site.conf") {
|
||||
|
||||
###################################
|
||||
# Checking Config File
|
||||
###################################
|
||||
|
||||
print "Found config file........................".$file."\n";
|
||||
print "Verifying file...........................";
|
||||
my ($config);
|
||||
$config = new Data::Config $dir.$file;
|
||||
unless (defined $config) {
|
||||
print "Couldn't open it.";
|
||||
$prereq = 0;
|
||||
} elsif ($config->param('dsn') =~ /\s$/) {
|
||||
print "DSN cannot end with a space.";
|
||||
$prereq = 0;
|
||||
} elsif ($config->param('dsn') !~ /\DBI\:\w+\:\w+/) {
|
||||
print "DSN is improperly formatted.";
|
||||
$prereq = 0;
|
||||
} elsif ($config->param('dbuser') =~ /\s$/) {
|
||||
print "dbuser cannot end with a space.";
|
||||
$prereq = 0;
|
||||
} elsif ($config->param('dbuser') =~ /\s$/) {
|
||||
print "dbpass cannot end with a space.";
|
||||
$prereq = 0;
|
||||
} else {
|
||||
print "OK\n";
|
||||
}
|
||||
|
||||
unless ($prereq) {
|
||||
print " Skipping this configuration.\n";
|
||||
$prereq = 1;
|
||||
} else {
|
||||
|
||||
###################################
|
||||
# Checking database
|
||||
###################################
|
||||
|
||||
print "Database connection......................";
|
||||
my ($dbh, $test);
|
||||
unless (eval {$dbh = DBI->connect($config->param('dsn'),$config->param('dbuser'),$config->param('dbpass'))}) {
|
||||
print "Can't connect with info provided. Skipping.\n";
|
||||
} else {
|
||||
print "OK\n";
|
||||
$dbh->disconnect();
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
closedir(DIR);
|
||||
}
|
||||
|
||||
|
||||
###################################
|
||||
# Checking Version
|
||||
###################################
|
||||
|
||||
print "Latest version...........................";
|
||||
my ($header, $userAgent, $request, $response, $version, $referer);
|
||||
$userAgent = new LWP::UserAgent;
|
||||
$userAgent->agent("WebGUI-Check/2.0");
|
||||
$userAgent->timeout(30);
|
||||
$header = new HTTP::Headers;
|
||||
$referer = "http://webgui.cli.getversion/".`hostname`;
|
||||
chomp $referer;
|
||||
$header->referer($referer);
|
||||
$request = new HTTP::Request (GET => "http://www.plainblack.com/downloads/latest-version.txt", $header);
|
||||
$response = $userAgent->request($request);
|
||||
$version = $response->content;
|
||||
chomp $version;
|
||||
if ($response->is_error) {
|
||||
print "Couldn't connect to Plain Black Software. Check your connection and try again.\n";
|
||||
} elsif ($version eq $WebGUI::VERSION) {
|
||||
print "OK\n";
|
||||
} else {
|
||||
print "You are using ".$WebGUI::VERSION." and ".$version." is available.\n";
|
||||
}
|
||||
|
||||
|
||||
print "\nTesting complete!\n";
|
||||
|
||||
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue