User:PockBot/SourceCode/112
Appearance
< User:PockBot | SourceCode
#!/usr/bin/perl -- #______________________________________________________________________________# # PockBot.pl RELEASE VERSION # # Author Dan Adams , (User:PocklingtonDan) # #______________________________________________________________________________# #______________________________________________________________________________# # RIGHTS MANAGEMENT ETC # # # # The source code for PockBot is supplied solely for the purposes of allowing # # other editors to comment on and improve the code, and/or to run the code as # # a clone. It may be distributed and modified as required for these purposes. # #______________________________________________________________________________# #______________________________________________________________________________# # CHANGES STILL TO MAKE # # # # - [none at this time] # # # # RECENT CHANGES # # # # 05.12.06 - Version 0.01 - source code released # # 05.12.06 - Version 0.02 - does not run now for non-existent categories # # 06.12.06 - Version 0.03 - Now writes to wikipedia # # 06.12.06 - Version 0.04 - Now adds signature to posts # # 06.12.06 - Version 0.05 - Now prints in DIV scrollbox to take up less room # # 06.12.06 - Version 0.06 - Now monitors server load and advises user # # 06.12.06 - Version 0.07 - Now gets correct category for all articles # # 06.12.06 - Version 1.00 - Released for trial. # # 07.12.06 - Version 1.01 - Colour-filling article classes as per templates # # 07.12.06 - Version 1.02 - Sortable DHTML columns added # # 07.12.06 - Version 1.03 - Added edit attribution to user running bot # # 07.12.06 - Version 1.04 - Logs IP Address of end user # # 08.12.06 - Version 1.05 - implemented 100-subcat limit to set finite limit # # 08.12.06 - Version 1.06 - Added progress bar to stop timeouts. # # 13.12.06 - Version 1.07 - Added link to run bot again on completion # # 14.12.06 - Version 1.08 - Fixed bug that included media in article list # # 18.12.06 - Version 1.09 - Removed old error-logging code from early debugging# # 18.12.06 - Version 1.10 - Made disk file locations global for easy change # # 18.12.06 - Version 1.11 - Modified to permit only single concurrent use # # 18.12.06 - Version 1.12 - Upped subcat limit to 1000 to enable for big cats # #______________________________________________________________________________# #______________________________________________________________________________# # WHAT THE SCRIPT DOES # # # # This script is a wikipedia bot. It acts as a web spider. Given a wikipedia # # category page to start from, it finds all articles listed in that category # # as well as all subcategories of that category. For every subcategory it # # pulls a list of articles. For all articles retrieved (a list of all articles # # in that category and its subcategories) it then retrieves the CLASS flag for # # each page from wikipedia. It then presents these results in tabulated form. # # # # INTENDED USE # # # # It is intended that this script would be useful to those trying to monitor # # all pages within a category for purposes of administration or for a project # # in order to monitor which articles need bringing up from stub or start class # # to full article status. # # # # CODE FORMATTING # # # # Code is formatted for ease of editing with Textpad (www.textpad.com) or # # similar editor with colour-coding meta-markup. It may be difficult to scan # # using a no-frills text editor. # #______________________________________________________________________________# #______________________________________________________________________________# # PACKAGES TO IMPORT (must be installed on your server) # #______________________________________________________________________________# 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; #______________________________________________________________________________# # SETTINGS # #______________________________________________________________________________# $|=1; #Disable buffering to allow progress bar to work. our $status_file = "/files/home2/thepaty/cgi-bin/status.txt"; # 0=DISABLED, 1=ENABLED, 2=IN USE (initiate with contents "1"). #______________________________________________________________________________# # MAIN ROUTINE # #______________________________________________________________________________# 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; #______________________________________________________________________________# # SUBROUTINES # #______________________________________________________________________________# sub startBot { my @gettheip = split(/\./,$ENV{'REMOTE_ADDR'}); my $remotehost = "$gettheip[0].$gettheip[1].$gettheip[2].$gettheip[3]"; &checkIfBotOnline; &printOnlineHeader; print "<FORM action=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi\" method=\"post\"><fieldset style=\"width: 425px;\">"; print "<legend style=\"font-family: arial, sans-serif; font-size: 10\">Please enter the wikipedia Category you wish to process</legend>"; print "<p><font face=\"arial\" size=\"2\" color=\"red\"><b>*</b></font> <font face=\"arial\" size=\"2\">Category:"; print "<INPUT type=\"text\" style=\"font-family: arial, serif; font-size: 12px;\" size=\"50\" name=\"category_specified\" value=\"Enter category name here!\"><br>"; print "<b><em>mandatory</em></b></font></p>"; print "<p><font face=\"arial\" size=\"2\">Your wikipedia username:"; print "<INPUT type=\"text\" style=\"font-family: arial, serif; font-size: 12px;\" size=\"35\" name=\"wikipedia_user\" value=\"\"><br>"; print "<b><em>optional but useful to attribute PockBot edits</em></b></font></p>"; print "<INPUT type=\"hidden\" name=\"action\" value=\"getMainCategory\">"; print "<INPUT type=\"hidden\" name=\"userIPAddress\" value=\"$remotehost\">"; print "<INPUT type=\"submit\" value=\"Start Pockbot\">"; print " </fieldset></FORM>"; print "<p><font face=\"arial\" size=\"2\"><b>Notes:</b><br><em>Do not run for a top-level category.</em><br><em>Bot may take over an hour to run for categories with many nested subcategories.</em></font></p>"; &printFooter; } #______________________________________________________________________________# sub getArticlesinCategory { my $content_articles = $_[0]; # if its not a wikipedia category page, return empty array unless ($content_articles =~ m/<div id="mw-pages">/){ $content_articles = ""; my @found_articles = split(/\|/,$content_articles); 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 = ""; } else { $content_articles =~ s/[\s\S]*<div id="mw-pages">//; $content_articles =~ s/<\/div>[\s\S]*/<\/div>/; $content_articles =~ s/[\s\S]*?<ul>/<ul>/; $content_articles =~ s/<h3>[\s\S]*?<\/h3>//g; $content_articles =~ s/<ul>//g; $content_articles =~ s/<\/ul>//g; $content_articles =~ s/<td>//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/<li>/|/g; $content_articles =~ s/\n//g; $content_articles =~ s/\|\|/\|/g; $content_articles =~ s/<a[\s\S]*?>//g; $content_articles =~ s/<\/a>//g; $content_articles =~ s/\|$//; $content_articles =~ s/^\|//; $content_articles =~ s/_/ /g; $content_articles =~ s/\s\|/\|/g; } my @found_articles = split(/\|/,$content_articles); return (@found_articles); } #______________________________________________________________________________# sub getSubCatsinCategory { my $content_subcats = $_[0]; # if its not a wikipedia category page, empty array unless ($content_subcats =~ m/<div id="mw-subcategories">/){ $content_subcats = ""; my @found_subcats = split(/\|/,$content_subcats); 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 = ""; } else { $content_subcats =~ s/[\s\S]*<div id="mw-subcategories">//; $content_subcats =~ s/<div id="mw-pages">[\s\S]*//; $content_subcats =~ s/<h3>[\s\S]*?<\/h3>//g; $content_subcats =~ s/<div[\s\S]*?>//g; $content_subcats =~ s/<\/div>//g; $content_subcats =~ s/<span[\s\S]*?<\/span>//g; $content_subcats =~ s/[\s\S]*?<ul>/<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/<td>//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; } my @found_subcats = split(/\|/,$content_subcats); return (@found_subcats); } #______________________________________________________________________________# sub processContents { my $category = $_[0]; my $contents = $_[1]; my $userRunningBot = $_[2]; my $userIPAddress = $_[3]; $category =~ s/_/ /g; #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 threads::shared; use Config; if ($Config{useithreads}) { # We have threads # Let user know spider is on the job. &printOnlineHeader; print "<form><fieldset style=\"width: 425px;\"><p><font face=\"arial\" size=\"2\">Thank you for using PockBot. You have requested a list of article classes for "; print " wikipedia category <a href=\"http://en.wikipedia.org/wiki/Category:$category\">$category</a>.</font></p>"; print "<p><font face=\"arial\" size=\"2\">The content will take some time to generate, espcially for large categories. When complete, the results will be posted to wikipedia for you at the <a href=\"http://en.wikipedia.org/wiki/Category_talk:$category\">category's talk page</a>.<br><br>"; print "<b>If your browser times out you may get a blank page, The data will still be written as requested and not affected by this.</font></p></fieldset></form>"; print "<p><font face=\"arial\" size=\"2\"><b>Progress:</b><br><img src=\"http://www.thepaty.plus.com/working.gif\" align=\"middle\" width=\"20\" height=\"20\">Working "; &printFooter; #Another thread to print progress bar to keep brower from timing out? my $keepRunningProgressBar : shared = 1; my $progressBar = threads->create(sub { while ($keepRunningProgressBar == 1) {sleep(5); print "<img src=\"http://www.thepaty.plus.com/dot.gif\" align=\"middle\">";} }); $progressBar->detach; # Set spider to work on requested category, in separate thread my $threadForSpidering = threads->new(\&workthread, $category, $contents, $userRunningBot,$userIPAddress); $threadForSpidering->join; $keepRunningProgressBar = 0; sleep(6); } else { &error("PockBot requires threads. This perl installation is not built with threads activated. PockBot cannot run."); } } } #______________________________________________________________________________# sub removeDuplicates { my @articles = @_; my @articles_no_duplicates = (); 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); } #______________________________________________________________________________# sub getAllArticlesIn { my @subcats = @_; my @new_articles = (); foreach my $individual_subcat (@subcats) { 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); } #______________________________________________________________________________# sub removeImages { my @articles_no_duplicates = @_; my @articles_no_images = (); foreach my $article (@articles_no_duplicates) { unless ($article =~ m/Image:/) { push(@articles_no_images, $article); } } return (@articles_no_images); } #______________________________________________________________________________# 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; 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 = "Featured Article"; } elsif ($contents =~ m/as GA-Class/i) { $class = "Good Article"; } elsif ($contents =~ m/This page is not an article and does not require/i) { $class = "Non-Article"; } else { $class = "unclassified"; } # add details of article class to hash $classes{$article} = $class; } return (%classes) } #______________________________________________________________________________# sub writeResultsToFile { my $replacement_text = $_[0]; my $replacement_page = $_[1]; my $tagWhoRequestedEdit = $_[2]; my $userIPAddress = $_[3]; my $timeStamp = getTimeStamp(); my $replacement_summary = "PockBot (run by IP:$userIPAddress) - Category articles summary as of $timeStamp"; use LWP::UserAgent; my $agent=LWP::UserAgent->new; $agent->agent('Perlwikipedia/0.90'); $agent->cookie_jar({file=> '.perlwikipedia-cookies'}); my $editor = "PockBot"; my $password = "*******"; 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§ion=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."); } } #______________________________________________________________________________# 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); } #______________________________________________________________________________# sub workthread { my $category = $_[0]; my $contents = $_[1]; my $userRunningBot = $_[2]; my $userIPAddress = $_[3]; my $tagWhoRequestedEdit = ""; if ($userRunningBot eq "") { $tagWhoRequestedEdit = "on behalf of an anonymous user"; } else { $tagWhoRequestedEdit = "on behalf of [[User:$userRunningBot|$userRunningBot]]"; } my @subcats = getSubCatsinCategory($contents); my @articles = getArticlesinCategory($contents); my $new_subcats_found_this_round = 1; my @subcats_searched_aleady = (); my $subCatLimit = 250; my $hitSubcatLimit = "false"; # Keep searching until no new subcats are found.in any categories searched while (($new_subcats_found_this_round > 0) && ($hitSubcatLimit eq "false")) { $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) { 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); } push(@subcats_searched_aleady, $existing_subcat); } else { #do nothing } } # 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) { push(@subcats, $proposed_new_subcat); $new_subcats_found_this_round++; if ($#subcats > $subCatLimit) { $hitSubcatLimit = "true"; } } else { #do nothing } } } # And now get a list of every article in every subcat my @new_articles = getAllArticlesIn(@subcats); my @articles = (@articles, @new_articles); # Remove duplicates and images from article list. my @articles_no_duplicates = removeDuplicates(@articles); my @articles_no_images = removeImages(@articles_no_duplicates); # Search talk pages for each article to find "class=X" classification my %classes = getArticleClasses(@articles_no_images); my $explainReducedResultsSet = ""; if ($hitSubcatLimit eq "true") { $explainReducedResultsSet = "'''Note: this category had more than $subCatLimit sub-categories. Only data from the first $subCatLimit sub-categories has been returned.'''<br><br>"; } else{ $explainReducedResultsSet = ""; } # Prepare text to print to results file my $text_to_print = ""; $text_to_print = "{{PockBotHeader|$category}}\n"; foreach my $article_title (@articles_no_images) { my $fetchedArticleClass = ""; if ($classes{$article_title}) { $fetchedArticleClass = $classes{$article_title}; } else { $fetchedArticleClass = "Error finding article class for $article_title"; } $fetchedArticleClass =~ s/Non-Article/NA/; $fetchedArticleClass =~ s/unclassified/''not yet classified''/; $fetchedArticleClass =~ s/Featured Article/FA/; $fetchedArticleClass =~ s/Good Article/GA/; my $cellColour = "white"; if ($fetchedArticleClass =~ m/Start/) { $cellColour = "#ffaa66"; } if ($fetchedArticleClass =~ m/Stub/) { $cellColour = "#ff6666"; } if ($fetchedArticleClass =~ m/^A$/) { $cellColour = "#66ffff"; } if ($fetchedArticleClass =~ m/B/) { $cellColour = "#ffff66"; } if ($fetchedArticleClass =~ m/NA/) { $cellColour = "whitesmoke"; } if ($fetchedArticleClass =~ m/''not yet classified''/) { $cellColour = "white"; } if ($fetchedArticleClass =~ m/FA/) { $cellColour = "#6699ff"; } if ($fetchedArticleClass =~ m/GA/) { $cellColour = "#66ff66"; } $text_to_print .= "{{PockBotData|$article_title|$fetchedArticleClass|$cellColour}}\n"; } $text_to_print .= "{{PockBotFooter|Edit by ~~~ ($tagWhoRequestedEdit)}}\n"; # write results to results.htm my $successfuledit = writeResultsToFile($text_to_print,$category,$tagWhoRequestedEdit,$userIPAddress); return "success"; } #______________________________________________________________________________# sub fetchContents { my $category = $_[0]; $category =~ s/\s/_/g; my $category_url = "http://en.wikipedia.org/wiki/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(1); # don't hammer the server! One read request every 1 second. return($category,$contents); } #______________________________________________________________________________# sub fetchTalkContents { my $article = $_[0]; $article =~ s/\s/_/g; my $article_url = "http://en.wikipedia.org/wiki/Talk:$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(1); # don't hammer the server! One read request every 1 second. return($article,$contents); } #______________________________________________________________________________# sub finishedRunning { my $category = $_[0]; my $category_url = "http://en.wikipedia.org/wiki/Category_talk:" . $category; print "<br><img src=\"http://www.thepaty.plus.com/tick.gif\" align=\"middle\" width=\"20\" height=\"20\"> <b>Finished</b> <small>(<a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=intro\">Run again for another category</a>)</small>.</font></p>"; &printFooter; } #______________________________________________________________________________# sub getMainCategory{ #Set bot in use open(STATUSFILE,">$status_file") || &error("Cannot open bot status file."); flock(STATUSFILE, 2) || &error("Cannot lock bot status file."); print STATUSFILE "2"; flock(STATUSFILE, 8); close (STATUSFILE); my $category = "BLANK"; $category = param('category_specified'); my $userRunningBot = param('wikipedia_user'); my $userIPAddress = param('userIPAddress'); if ($category eq "BLANK") { &error("Error receiving category name"); } else { my ($category, $contents) = fetchContents($category); &processContents($category,$contents,$userRunningBot,$userIPAddress); &finishedRunning($category); } #Set bot to available again 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); } #______________________________________________________________________________# sub enableBot { 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) { &printOnlineHeader; print "<p><font face=\"arial\">PockBot is already enabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=disableBot\">Disable PockBot</a></font></p>"; &printFooter; exit; } elsif ($bot_enabled == 0) { 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 "<p><font face=\"arial\">PockBot is now enabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=disableBot\">Disable Pockbot</a></font></p>"; &printFooter; exit; } else { &error("Unrecognised bot status. Something has gone wrong."); } } #______________________________________________________________________________# sub disableBot { 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) { &printOfflineHeader; print "<p><font face=\"arial\">PockBot is already disabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable PockBot</a></font></p>"; &printFooter; exit; } elsif ($bot_enabled == 1) { 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 "<p><font face=\"arial\">PockBot is now disabled. <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable Pockbot</a></font></p>"; &printFooter; exit; } else { &error("Unrecognised bot status. Something has gone wrong."); } } #______________________________________________________________________________# sub checkIfBotOnline { 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) { &printOfflineHeader; print "<p><font face=\"arial\">PockBot is currently disabled. If you are certain it has not been disabled for a reason, you can <a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable PockBot</a></font></p>"; &printFooter; exit; } elsif ($bot_enabled == 1) { #no action necessary } elsif ($bot_enabled == 2) { &printOfflineHeader; print "<p><font face=\"arial\">PockBot is currently in use. Only a single concurrent usage of PockBot is permitted in order to minimize wikipedia server load. Please try again later.</p>"; &printFooter; exit; } else { &error("Unrecognised bot status. Something has gone wrong."); } } #______________________________________________________________________________# 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); } #______________________________________________________________________________# sub printOnlineHeader { print "Content-type: text/html\n\n"; print "<html><head><title>PockBot</title><script src=\"sorttable.js\"></script></head><body>"; 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></font><br>"; print "<font face=\"arial\" size=\"1\"><b>Pockbot is currently ONLINE / ENABLED</b> (<a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=disableBot\">Disable PockBot</a>)</font><br>"; print "<img src=\"http://www.thepaty.plus.com/pockbot.gif\"><br>"; my$currentServerLoad = getWikipediaLoad(); print "<img src=\"http://www.thepaty.plus.com/load_$currentServerLoad.gif\">"; } #______________________________________________________________________________# sub printOfflineHeader { print "Content-type: text/html\n\n"; print "<html><head><title>PockBot</title></head><body>"; print "<p><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></font></p>"; print "<p><font face=\"arial\" size=\"1\"><b>Pockbot is currently OFFLINE / DISABLED</b> (<a href=\"http://ccgi.thepaty.plus.com/cgi-bin/PockBot.cgi?action=enableBot\">Enable PockBot</a>)</font><p>"; print "<img src=\"http://www.thepaty.plus.com/pockbot.gif\">"; } #______________________________________________________________________________# sub printFooter { print "</body></html>"; } #______________________________________________________________________________# sub error { &printOnlineHeader; print "<p><font face=\"arial\">ERROR: $_[0]</font></p>"; &printFooter; exit; }