User:PockBot/SourceCode/102

use strict; use warnings; use CGI; use CGI::Carp "fatalsToBrowser"; use LWP::Simple; use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw(GET); use HTTP::Response;
 * 1) !/usr/bin/perl -w


 * 1) ______________________________________________________________________________#
 * 2) PockBot.pl                      TRIAL VERSION                                #
 * 3) Author                          Dan Adams, (User:PocklingtonDan)            #
 * 4) ______________________________________________________________________________#


 * 1) ______________________________________________________________________________#
 * 2) RIGHTS MANAGEMENT ETC                                                        #
 * 3) The source code for PockBot is supplied solely for the purposes of allowing  #
 * 4) other editors to comment on and improve the code, and/or to run the code as  #
 * 5) a clone. It may be distributed and modified as required for these purposes.  #
 * 6) ______________________________________________________________________________#
 * 1) ______________________________________________________________________________#


 * 1) ______________________________________________________________________________#
 * 2) CHANGES STILL TO MAKE                                                        #
 * 3) - Progress bar                                                               #
 * 4) - 1.10 -Log IP address of user and in edit state "Pockbot on behalf of IP X" #
 * 5) - Solve problem of what to do with very large categories                     #
 * 6) RECENT CHANGES                                                               #
 * 7) 05.12.06 - Version 0.01 - source code released                               #
 * 8) 05.12.06 - Version 0.02 - does not run now for non-existent categories       #
 * 9) 06.12.06 - Version 0.03 - Now writes to wikipedia                            #
 * 10) 06.12.06 - Version 0.04 - Now adds signature to posts                        #
 * 11) 06.12.06 - Version 0.05 - Now prints in DIV scrollbox to take up less room   #
 * 12) 06.12.06 - Version 0.06 - Now monitors server load and advises user          #
 * 13) 06.12.06 - Version 0.07 - Now gets correct category for all articles         #
 * 14) 06.12.06 - Version 1.00 - Released for trial.                                #
 * 15) 07.12.06 - Version 1.01 - Colour-filling article classes as per templates    #
 * 16) 07.12.06 - Version 1.02 - Sortable DHTML columns added                       #
 * 17) ______________________________________________________________________________#
 * 1) 07.12.06 - Version 1.01 - Colour-filling article classes as per templates    #
 * 2) 07.12.06 - Version 1.02 - Sortable DHTML columns added                       #
 * 3) ______________________________________________________________________________#


 * 1) ______________________________________________________________________________#
 * 2) WHAT THE SCRIPT DOES                                                         #
 * 3) This script is a wikipedia bot. It acts as a web spider. Given a wikipedia   #
 * 4) category page to start from, it finds all articles listed in that category   #
 * 5) as well as all subcategories of that category. For every subcategory it      #
 * 6) pulls a list of articles. For all articles retrieved (a list of all articles #
 * 7) in that category and its subcategories) it then retrieves the CLASS flag for #
 * 8) each page from wikipedia. It then presents these resulsts in tabulated form. #
 * 9) INTENDED USE                                                                 #
 * 10) It is intended that this script would be useful to those trying to monitor   #
 * 11) all pages within a category for purposes of administration or for a project  #
 * 12) in order to monitor which articles need bringing up from stub or start class #
 * 13) to full article status.                                                      #
 * 14) CODE FORMATTING                                                              #
 * 15) Code is formatted for ease of editing with Textad (www.textpad.com) or       #
 * 16) similar editor with colour-coding meta-markup. It may be difficult to scan   #
 * 17) using a no-frills text editor.                                               #
 * 18) ______________________________________________________________________________#
 * 1) Code is formatted for ease of editing with Textad (www.textpad.com) or       #
 * 2) similar editor with colour-coding meta-markup. It may be difficult to scan   #
 * 3) using a no-frills text editor.                                               #
 * 4) ______________________________________________________________________________#
 * 1) ______________________________________________________________________________#


 * 1) ______________________________________________________________________________#
 * 2) MAIN ROUTINE                                                                 #
 * 3) ______________________________________________________________________________#

use CGI qw(:standard Vars); my $action = param('action') || 'startBot';

if ($action eq 'intro') {&startBot;} elsif ($action eq 'disableBot') {&disableBot;} elsif ($action eq 'enableBot') {&enableBot;} elsif ($action eq 'getMainCategory') {&getMainCategory;} else {&error("Unrecognised action request");} exit;


 * 1) ______________________________________________________________________________#
 * 2) SUBROUTINES                                                                  #
 * 3) ______________________________________________________________________________#

sub startBot { &checkIfBotOnline; &logAction("Bot requested"); &printOnlineHeader; print " Please enter the wikipedia Category you wish to process below: "; print ""; print " Category:"; print " "; print " Note: Bot may take up to an hour to run for large categories. "; print ""; print ""; print " "; &printFooter; }


 * 1) ______________________________________________________________________________#

sub getArticlesinCategory { my $content_articles = $_[0]; &logAction("Searching for articles in this category ");

# if its not a wikipedia category page, return empty array unless ($content_articles =~ m/ /){ $content_articles = ""; my @found_articles = split(/\|/,$content_articles); &logAction("Found 0 articles in this category "); return (@found_articles); }

# empty array if no articles, else populate with article names if ($content_articles =~ m/There are 0 pages in this section of this category/){ $content_articles = ""; &logAction("Found 0 articles in this category"); }  else { $content_articles =~ s/[\s\S]* //; $content_articles =~ s/<\/div>[\s\S]*/<\/div>/; $content_articles =~ s/[\s\S]*?//; $content_articles =~ s/ [\s\S]*?<\/h3>//g; $content_articles =~ s///g; $content_articles =~ s/<\/ul>//g; $content_articles =~ s/ //g; $content_articles =~ s/<\/td>//g; $content_articles =~ s/<\/div>//g; $content_articles =~ s/<\/tr>//g; $content_articles =~ s/<\/table>//g; $content_articles =~ s/<\/li>/|/g; $content_articles =~ s//|/g; $content_articles =~ s/\n//g; $content_articles =~ s/\|\|/\|/g; $content_articles =~ s///g; $content_articles =~ s/<\/a>//g; $content_articles =~ s/\|$//; $content_articles =~ s/^\|//; $content_articles =~ s/_/ /g; $content_articles =~ s/\s\|/\|/g; &logAction("Found 1 or more articles in this category"); }   my @found_articles = split(/\|/,$content_articles); return (@found_articles); }


 * 1) ______________________________________________________________________________#

sub getSubCatsinCategory { my $content_subcats = $_[0]; &logAction("Searching for subcats in this category");

# if its not a wikipedia category page, empty array unless ($content_subcats =~ m/ /){ $content_subcats = ""; my @found_subcats = split(/\|/,$content_subcats); &logAction("Found 0 subcats in this category"); return (@found_subcats); }

# empty array if no subcats, else populate with subcat names if ($content_subcats =~ m/There are 0 subcategories to this category/){ $content_subcats = ""; &logAction("Found 0 subcats in this category"); }  else { $content_subcats =~ s/[\s\S]* //; $content_subcats =~ s/ [\s\S]*//; $content_subcats =~ s/ [\s\S]*?<\/h3>//g; $content_subcats =~ s///g; $content_subcats =~ s/<\/div>//g; $content_subcats =~ s///g; $content_subcats =~ s/[\s\S]*?/<ul>/; $content_subcats =~ s/<ul>//g; $content_subcats =~ s/<\/ul>//g; $content_subcats =~ s/<\/li>/|/g; $content_subcats =~ s/<li>/|/g; $content_subcats =~ s/<a[\s\S]*?>//g; $content_subcats =~ s/<\/a>//g; $content_subcats =~ s/\n//g; $content_subcats =~ s/\|\|/\|/g; $content_subcats =~ s/ //g; $content_subcats =~ s/<\/td>//g; $content_subcats =~ s/<\/tr>//g; $content_subcats =~ s/<\/table>//g; $content_subcats =~ s/[\s]*?\|/\|/g; $content_subcats =~ s/\|$//; $content_subcats =~ s/^\|//; $content_subcats =~ s/\|\|/\|/g; &logAction("Found 1 or more subcats in category $content_subcats"); }

my @found_subcats = split(/\|/,$content_subcats); return (@found_subcats); }


 * 1) ______________________________________________________________________________#

sub processContents { my $category = $_[0]; my $contents = $_[1]; $category =~ s/_/ /g;

&logAction("Starting to process category $category");

#Check to make sure category is valid my ($testcategory, $testcontents) = fetchContents($category); if ($testcontents =~ m/noarticletext/) { &error("You specified an invalid category. Please check your spelling and capitalization and try again."); }   else { #Seperate the page generation from spider work use threads; use Config; if ($Config{useithreads}) { # We have threads # Let user know spider is on the job. &logAction("Notifying user bot starting"); &printOnlineHeader; print " <font face=\"arial\" size=\"2\">PockBot is now running - DO NOT CLOSE THIS WINDOW "; print " <font face=\"arial\" size=\"2\">Thank you for using PockBot. You wanted a list of article classes for "; print " wikipedia category <a href=\"http://en.wikipedia.org/wiki/Category:$category\">$category</a>. "; print " <font face=\"arial\" size=\"2\">The content will take some time to generate. When complete, the results will be posted to wikipedia for you. "; print "In respect for wikipedia's servers, PockBot will only make one read request to wikipedia servers every second "; print "PockBot can read 3600 pages an hour under ideal network conditions. Large categories may therefore take up to an hour to run "; print " <font face=\"arial\" size=\"2\">Progress: PockBot is running... "; &printFooter; # Set spider to work on requested category, in separate thread my $threadForSpidering = threads->new(\&workthread, $category, $contents); #$threadForSpidering->detach; my $successfuledit = $threadForSpidering->join; }       else { &error("PockBot requires threads. This perl installation is not built with threads activated. PockBot cannot run."); }   } }


 * 1) ______________________________________________________________________________#

sub removeDuplicates { my @articles = @_; my @articles_no_duplicates = ; &logAction("Removing duplicates from found articles list."); foreach my $suggested_article (@articles) { my $already_exists = 0; foreach my $existing_article (@articles_no_duplicates) { if ($suggested_article eq $existing_article) { $already_exists = 1; }       }        if ($already_exists == 0) { push(@articles_no_duplicates, $suggested_article); }   }    return (@articles_no_duplicates); }


 * 1) ______________________________________________________________________________#

sub getAllArticlesIn { my @subcats = @_; my @new_articles = ; foreach my $individual_subcat (@subcats) { &logAction("Searching for new articles in subcat $individual_subcat"); my ($subcategory, $subcategorycontents) = fetchContents($individual_subcat); my @found_articles = getArticlesinCategory($subcategorycontents); foreach my $found_article (@found_articles) { push(@new_articles, $found_article); }   }    return (@new_articles); }


 * 1) ______________________________________________________________________________#

sub getArticleClasses { my @articles_no_duplicates = @_; my %classes = ; foreach my $article_title (@articles_no_duplicates) { my ($article, $contents) = fetchTalkContents($article_title); my $class = "unclassified"; $article =~ s/_/ /g; &logAction("Getting article class for article $article_title"); if ($contents =~ m/as Start-Class/i) { $class = "Start"; }           elsif ($contents =~ m/as Stub-Class/i) { $class = "Stub"; }           elsif ($contents =~ m/as A-Class/i) { $class = "A"; }           elsif ($contents =~ m/as B-Class/i) { $class = "B"; }           elsif ($contents =~ m/as FA-Class/i) { $class = "FA (Featured article)"; }           elsif ($contents =~ m/as GA-Class/i) { $class = "GA (Good article)"; }           elsif ($contents =~ m/This page is not an article and does not require/i) { $class = "NA (non-article)"; }           else { $class = "unclassified"; }

# add details of article class to hash $classes{$article} = $class; }   return (%classes) }


 * 1) ______________________________________________________________________________#

sub writeResultsToFile { my $replacement_text = $_[0]; my $replacement_page = $_[1]; my $timeStamp = getTimeStamp; my $replacement_summary = "PockBot - Category articles summary as of $timeStamp"; &logAction("Writing bot results to file."); use LWP::UserAgent; my $agent=LWP::UserAgent->new; $agent->agent('Perlwikipedia/0.90'); $agent->cookie_jar({file=> '.perlwikipedia-cookies'});

my $editor = "PockBot"; my $password = "*********";	# INTENTIONALLY BLANKED! my $login = HTTP::Request->new(POST => "http://en.wikipedia.org/w/index.php?title=Special:Userlogin&action=submitlogin&type=login"); $login->content_type('application/x-www-form-urlencoded'); $login->content("wpName=$editor&wpPassword=$password&wpRemember=1&wpLoginattempt=Log+in"); my $logger_inner = $agent->request($login); my $do_redirect=HTTP::Request->new(GET =>'http://en.wikipedia.org/w/index.php?title=Special:Userlogin&wpCookieCheck=login'); my $redirecter= $agent->request($do_redirect); my $is_success=$redirecter->content; if ($is_success=~m/\QYou have successfully signed in to Wikipedia as "$editor".\E/) {

use HTML::Form; my $ua = LWP::UserAgent->new; $ua->agent("Perlwikipedia/0.90"); $ua->cookie_jar($agent->cookie_jar); my $response = $ua->get("http://en.wikipedia.org/w/index.php?title=Category_talk:$replacement_page&action=edit&section=new"); my $form = HTML::Form->parse($response);

my $text = $form->find_input('wpTextbox1')->value; my $summary = $form->find_input('wpSummary')->value; my $save = $form->find_input('wpSave')->value; my $edittoken = $form->find_input('wpEditToken')->value; my $starttime = $form->find_input('wpStarttime')->value; my $edittime = $form->find_input('wpEdittime')->value;

$form->value('wpTextbox1', $replacement_text); $form->value('wpSummary', $replacement_summary ); $response = $ua->request($form->click);

return "success"; }   else { &error("Login to wikipedia failed."); } }


 * 1) ______________________________________________________________________________#

sub getTimeStamp { my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun); my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime; my $year = 1900 + $yearOffset; my $timeNow = "$hour:$minute:$second, $weekDays[$dayOfWeek] $months[$month] $dayOfMonth, $year"; return ($timeNow); }


 * 1) ______________________________________________________________________________#

sub logAction { my $actionToLog = $_[0]; my $log_file = '/files/home2/thepaty/cgi-bin/log.htm'; my $timeStamp = getTimeStamp; open(LOGFILE,">>$log_file") || &error("Cannot open log file."); flock(LOGFILE, 2) || &error("Cannot lock log file."); print LOGFILE "$timeStamp: $actionToLog "; flock(LOGFILE, 8); close (LOGFILE); #print "<img src=\"http://www.thepaty.plus.com/dot.gif\">"; }


 * 1) ______________________________________________________________________________#

sub workthread {

my $category = $_[0]; my $contents = $_[1]; &logAction("Starting work thread for category $category"); my @subcats = getSubCatsinCategory($contents); my @articles = getArticlesinCategory($contents); my $new_subcats_found_this_round = 1; my @subcats_searched_aleady = ;

# Keep searching until no new subcats are found.in any categories searched while ($new_subcats_found_this_round > 0) { $new_subcats_found_this_round = 0; my @proposed_extra_subcats = ; # Perform a search of every category we currently know of       foreach my $existing_subcat (@subcats) { my $already_searched = 0; # If already searched this category in an earlier pass, skip it. foreach my $searched_subcat (@subcats_searched_aleady) { if ($existing_subcat eq $searched_subcat) { $already_searched = 1; }           }

# If not already searched, get all subcats of that category if ($already_searched == 0) { &logAction("Have not searched subcat $existing_subcat already"); my ($subcategory, $subcategorycontents) = fetchContents($existing_subcat); my @additional_subcats = getSubCatsinCategory($subcategorycontents); foreach my $proposed_additional_subcat (@additional_subcats) { push(@proposed_extra_subcats, $proposed_additional_subcat); &logAction("Found possible new subcat $proposed_additional_subcat"); }               push(@subcats_searched_aleady, $existing_subcat); }           else { &logAction("Have searched subcat $existing_subcat already"); }       }

# If this new found subcat isn't a duplicate of one we already know about... foreach my $proposed_new_subcat (@proposed_extra_subcats) { my $already_exists = 0; foreach my $existing_subcat (@subcats) { if ($proposed_new_subcat eq $existing_subcat) { $already_exists = 1; }           }            # then add it to our master list if ($already_exists == 0) { &logAction("subcat $proposed_new_subcat is a genuinely new subcategory, adding to master list"); push(@subcats, $proposed_new_subcat); $new_subcats_found_this_round++; }           else { &logAction("subcat $proposed_new_subcat already existed in master list, ignoring"); }       }        &logAction("$new_subcats_found_this_round new subcats found this round. If greater than zero, should run through again"); }   # And now get a list of every article in every subcat my @new_articles = getAllArticlesIn(@subcats); my @articles = (@articles, @new_articles);

# Remove duplicates from article list. my @articles_no_duplicates = removeDuplicates(@articles);

# Search talk pages for each article to find "class=X" classification my %classes = getArticleClasses(@articles_no_duplicates);

# Prepare text to print to results file my $text_to_print = "<div style=\"height: 300px; width:100%; overflow:auto; border: thin solid black; background: #FFFFFF; padding: 4px; text-align: left;\">"; $text_to_print .= " <font face=\"arial\">List of all pages in category "; $text_to_print .= " retrieved by PockBot. "; $text_to_print .= "PockBot is currently Undergoing Trials. If you have any comments on its performance please leave them at Bots/Requests_for_approval/PockBot "; $text_to_print .= " ~ ";

# write results to results.htm my $successfuledit = writeResultsToFile($text_to_print,$category);

return "success"; }


 * 1) ______________________________________________________________________________#

sub fetchContents { my $category = $_[0]; $category =~ s/\s/_/g; my $category_url = "http://en.wikipedia.org/wiki/Category:". $category; &logAction("Fetching page contents for category $category"); my $browser = LWP::UserAgent->new; $browser->timeout(60); my $request = HTTP::Request->new(GET => $category_url); my $response = $browser->request($request); if ($response->is_error) {printf "%s\n", $response->status_line;} my $contents = $response->content; sleep(2); # don't hammer the server! One read request every 1 second. return($category,$contents); }


 * 1) ______________________________________________________________________________#

sub fetchTalkContents { my $article = $_[0]; $article =~ s/\s/_/g; my $article_url = "http://en.wikipedia.org/wiki/Talk:$article"; &logAction("Fetching talk page contents for article $article"); my $browser = LWP::UserAgent->new; $browser->timeout(60); my $request = HTTP::Request->new(GET => $article_url); my $response = $browser->request($request); if ($response->is_error) {printf "%s\n", $response->status_line;} my $contents = $response->content; sleep(2); # don't hammer the server! One read request every 1 second. return($article,$contents); }


 * 1) ______________________________________________________________________________#

sub finishedRunning { my $category = $_[0]; my $category_url = "http://en.wikipedia.org/wiki/Category_talk:". $category; &logAction("Finished processing category $category"); print " <font face=\"arial\" size=\"2\">PockBot has finished running. The results should be visible on the talk page at <a href=\"$category_url\">Category_talk:$category</a> "; &printFooter; }


 * 1) ______________________________________________________________________________#

sub resetLogAndResultsFiles {

my $log_file = '/files/home2/thepaty/cgi-bin/log.htm'; my $results_file = '/files/home2/thepaty/cgi-bin/results.htm'; &logAction("Resetting log and results files to empty");

open(LOGFILE,">$log_file") || &error("Cannot open log file."); flock(LOGFILE, 2) || &error("Cannot lock log file."); print LOGFILE ""; flock(LOGFILE, 8); close (LOGFILE); open(RESULTSFILE,">$results_file") || &error("Cannot open log file."); flock(RESULTSFILE, 2) || &error("Cannot lock log file."); print RESULTSFILE ""; flock(RESULTSFILE, 8); close (RESULTSFILE);

}


 * 1) ______________________________________________________________________________#

sub getMainCategory{ my $category = "BLANK"; $category = param('category_specified'); &resetLogAndResultsFiles; &logAction("Bot started for category $category"); if ($category eq "BLANK") { &error("Error receiving category name"); }   else { my ($category, $contents) = fetchContents($category); &processContents($category,$contents); &finishedRunning($category); } }


 * 1) ______________________________________________________________________________#

sub enableBot {

my $status_file = "/files/home2/thepaty/cgi-bin/status.txt"; &logAction("Bot enable request made"); open(STATUSFILE,"$status_file") || &error("Cannot open bot status file."); flock(STATUSFILE, 2) || &error("Cannot lock bot status file."); my $current_status = <STATUSFILE>; flock(STATUSFILE, 8); close (STATUSFILE); chomp($current_status); my $bot_enabled = $current_status;

if ($bot_enabled == 1) { &logAction("Bot already enabled, no action necesary"); &printOnlineHeader; print " <font face=\"arial\">PockBot is already enabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=disableBot\">Disable PockBot</a> "; &printFooter; exit; }   elsif ($bot_enabled == 0) { &logAction("Bot currently disabled. Enabling bot.");

open(STATUSFILE,">$status_file") || &error("Cannot open bot status file."); flock(STATUSFILE, 2) || &error("Cannot lock bot status file."); print STATUSFILE "1"; flock(STATUSFILE, 8); close (STATUSFILE);

&printOnlineHeader; print " <font face=\"arial\">PockBot is now enabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=disableBot\">Disable Pockbot</a> "; &printFooter; exit; }   else { &error("Unrecognised bot status. Something has gone wrong."); } }


 * 1) ______________________________________________________________________________#

sub disableBot {

my $status_file = "/files/home2/thepaty/cgi-bin/status.txt"; &logAction("Bot disable request made");

open(STATUSFILE,"$status_file") || &error("Cannot open bot status file."); flock(STATUSFILE, 2) || &error("Cannot lock bot status file."); my $current_status = <STATUSFILE>; flock(STATUSFILE, 8); close (STATUSFILE); chomp($current_status); my $bot_enabled = $current_status;

if ($bot_enabled == 0) { &logAction("Bot is already disabled. No action necessary"); &printOfflineHeader; print " <font face=\"arial\">PockBot is already disabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable PockBot</a> "; &printFooter; exit; }   elsif ($bot_enabled == 1) { &logAction("Bot is currently enabled. Disabling bot.");

open(STATUSFILE,">$status_file") || &error("Cannot open bot status file."); flock(STATUSFILE, 2) || &error("Cannot lock bot status file."); print STATUSFILE "0"; flock(STATUSFILE, 8); close (STATUSFILE);

&printOfflineHeader; print " <font face=\"arial\">PockBot is now disabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable Pockbot</a> "; &printFooter; exit; }   else { &error("Unrecognised bot status. Something has gone wrong."); } }


 * 1) ______________________________________________________________________________#

sub checkIfBotOnline {

my $status_file = '/files/home2/thepaty/cgi-bin/status.txt'; &logAction("Checking if bot is online");

open(STATUSFILE,"$status_file") || &error("Cannot open bot status file."); flock(STATUSFILE, 2) || &error("Cannot lock bot status file."); my $current_status = <STATUSFILE>; flock(STATUSFILE, 8); close (STATUSFILE); chomp($current_status); my $bot_enabled = $current_status;

if ($bot_enabled == 0) { &logAction("Bot is disabled, cannot perform action"); &printOfflineHeader; print " <font face=\"arial\">PockBot is currently disabled. If you are certain it has nt been disabled for a reason, you can <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable PockBot</a> "; &printFooter; exit; }   elsif ($bot_enabled == 1) { &logAction("Bot is enabled, we are good to go."); #no action necessary }   else { &error("Unrecognised bot status. Something has gone wrong."); } }


 * 1) ______________________________________________________________________________#

sub getWikipediaLoad {

my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun); my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime; $hour = $hour - 6; # adjust to get US time from GMT of PockBot's server.

my $currentServerLoad = "$hour";

$currentServerLoad =~ s/10/low/g; $currentServerLoad =~ s/11/low/g; $currentServerLoad =~ s/12/fairlylow/g; $currentServerLoad =~ s/13/fairlyhigh/g; $currentServerLoad =~ s/14/high/g; $currentServerLoad =~ s/15/veryhigh/g; $currentServerLoad =~ s/16/veryhigh/g; $currentServerLoad =~ s/17/high/g; $currentServerLoad =~ s/18/high/g; $currentServerLoad =~ s/19/veryhigh/g; $currentServerLoad =~ s/20/veryhigh/g; $currentServerLoad =~ s/21/veryhigh/g; $currentServerLoad =~ s/22/veryhigh/g; $currentServerLoad =~ s/0/fairlyhigh/g; $currentServerLoad =~ s/1/fairlylow/g; $currentServerLoad =~ s/2/low/g; $currentServerLoad =~ s/3/verylow/g; $currentServerLoad =~ s/4/verylow/g; $currentServerLoad =~ s/5/verylow/g; $currentServerLoad =~ s/6/verylow/g; $currentServerLoad =~ s/7/verylow/g; $currentServerLoad =~ s/8/low/g; $currentServerLoad =~ s/9/low/g;

return ($currentServerLoad); }


 * 1) ______________________________________________________________________________#

sub printOnlineHeader { print "Content-type: text/html\n\n"; print "  PockBot <script src=\"sorttable.js\">   "; print " <font face=\"arial\" size=\"1\"><a href=\"http://en.wikipedia.org/wiki/Main_Page\">Wikipedia</a> > <a href=\"http://en.wikipedia.org/wiki/User:PockBot\">Pockbot's User Page</a> "; print " <font face=\"arial\" size=\"1\">Pockbot is currently ONLINE / ENABLED (<a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=disableBot\">Disable PockBot</a>) "; print "<img src=\"http://www.thepaty.plus.com/pockbot.gif\"> "; my$currentServerLoad = getWikipediaLoad; print "<img src=\"http://www.thepaty.plus.com/load_$currentServerLoad.gif\">"; }

sub printOfflineHeader { print "Content-type: text/html\n\n"; print "  PockBot   "; print " <font face=\"arial\" size=\"1\"><a href=\"http://en.wikipedia.org/wiki/Main_Page\">Wikipedia</a> > <a href=\"http://en.wikipedia.org/wiki/User:PockBot\">Pockbot's User Page</a> "; print " <font face=\"arial\" size=\"1\">Pockbot is currently OFFLINE / DISABLED (<a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable PockBot</a>) "; print "<img src=\"http://www.thepaty.plus.com/pockbot.gif\">"; }


 * 1) ______________________________________________________________________________#

sub printFooter { print " "; }


 * 1) ______________________________________________________________________________#

sub error { &checkIfBotOnline; &logAction("ERROR: $_[0]"); &printOnlineHeader; print " <font face=\"arial\">ERROR: $_[0] "; &printFooter; exit; }