From 2671feae26c0e1bcdcbb6a711630d88ec39c314b Mon Sep 17 00:00:00 2001
From: JT Smith <jt@plainblack.com>
Date: Wed, 29 May 2002 17:20:51 +0000
Subject: [PATCH] Moved the offline executables to "sbin". Updated
 testEnvironment.pl to test all of the conf files in etc.

---
 docs/gotcha.txt         |   5 +
 sbin/preload.perl       |  36 ++++
 sbin/runHourly.pl       |  85 ++++++++++
 sbin/testEnvironment.pl | 361 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 487 insertions(+)
 create mode 100644 sbin/preload.perl
 create mode 100644 sbin/runHourly.pl
 create mode 100644 sbin/testEnvironment.pl

diff --git a/docs/gotcha.txt b/docs/gotcha.txt
index a1ec73eea..20df4f739 100644
--- a/docs/gotcha.txt
+++ b/docs/gotcha.txt
@@ -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
diff --git a/sbin/preload.perl b/sbin/preload.perl
new file mode 100644
index 000000000..47703565f
--- /dev/null
+++ b/sbin/preload.perl
@@ -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;
+
+
diff --git a/sbin/runHourly.pl b/sbin/runHourly.pl
new file mode 100644
index 000000000..6e29bb112
--- /dev/null
+++ b/sbin/runHourly.pl
@@ -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;
+}
+
diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl
new file mode 100644
index 000000000..b0b0aa7a3
--- /dev/null
+++ b/sbin/testEnvironment.pl
@@ -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";
+
+
+