#!/usr/bin/perl -T

#______________________________________________________________________________#
#DeleteAsstBot.pl                 PRE-RELEASE VERSION                          #
# Author                          Dan Adams , (User:PocklingtonDan)            #
#______________________________________________________________________________#

#______________________________________________________________________________#
# CHANGES STILL TO MAKE                                                        #
#                                                                              #
# - Don't allow use by blocked IPs?                                            #
#   http://en.wikipedia.org/w/index.php?title=Special%3AIpblocklist&action=search&ip=PLACE_IP_HERE
# - Change "ARTICLENAME (nomination N)" to "Articlename (nth nomination)".     #
# - add question mark/help link next to each input field                       #
#                                                                              #
# RECENT CHANGES                                                               #
#                                                                              #
# 09.01.06 - Version 0.01 - Initial code written                               #
# 10.01.06 - Version 0.02 - Fixed bug where it wrote bot sig twice.            #
# 11.01.06 - Version 0.03 - Added edit token system                            #
#                                                                              #
#______________________________________________________________________________#

#______________________________________________________________________________#
# WHAT THE SCRIPT DOES                                                         #
#                                                                              #
# This script is a wikipedia bot. It acts as a wizard interface for the process#
# of nominating an article for deletion, a currently manual task. It takes     #
# user input in a wizard interface and makes the necessary wikipedia edits in  #
# the background.                                                              #
#                                                                              #
# INTENDED USE                                                                 #
#                                                                              #
# It is intended that ultimately this script is placed on the toolserver and   #
# becomes the default method of nominating articles for deletion from wikipedia#
#                                                                              #
#______________________________________________________________________________#

#______________________________________________________________________________#
# PACKAGES TO IMPORT (must be installed on server)                             #
#______________________________________________________________________________#

# "Use Always" Packages
use strict;
use warnings;
use CGI::Carp "fatalsToBrowser"; # during testing and debugging only

# Required Packages for features.
use CGI qw(:standard Vars);
use URI::Escape;
use LWP::Simple;
use LWP::UserAgent;
use HTML::Template;

#______________________________________________________________________________#
# SETTINGS                                                                     #
#______________________________________________________________________________#

#Variables
my $editorName = "**********";
my $editorPassword = "**************";
my $language = "en"; # language code for wikipedia namespace
my $enabled = "true"; # set to false to take offline/disable

#Local paths
my $editTokenFile = "/*********/editToken.txt";
my $inputFormFile = "/**********/inputForm.tmpl";
my $errorFile = "/*********/error.tmpl";
my $respondToUserFile = "/*************/respondToUser.tmpl";

# Web paths
my $pathToScript = "http://*********.com/cgi-bin";
my $pathToImages = "http://www.**********.com";



#______________________________________________________________________________#
# MAIN ROUTINE                                                                 #
#______________________________________________________________________________#

my $action = param('action') or 'getInput';

if ($enabled eq "true") {
    if ($action eq 'getInput') {getInput;}
    elsif ($action eq 'processInput') {processInput;}
    else {error("Unrecognised action request");}
}
else {error("Bot is currently offline for maintenance.");}
exit;


#______________________________________________________________________________#
# SUBROUTINES                                                                  #
#______________________________________________________________________________#

sub getInput {
    my $remoteHost = $ENV{'REMOTE_ADDR'};
    my $editToken = generateEditToken($remoteHost);
    printInputForm($editToken);
    return();
}

#______________________________________________________________________________#

sub processInput {
    my $editToken = param('editToken');
    my $articleForDeletion = param('articleForDeletion');
    my $categoryForDeletion = param('categoryForDeletion');
    my $reasonForDeletion = param('reasonForDeletion');

    validateFilePaths($editTokenFile);
    validateBasicFormats($editToken, $articleForDeletion, $categoryForDeletion, $reasonForDeletion);
    validatePageExists($articleForDeletion);
    validateCategoryCode($categoryForDeletion);
    my $remoteHost = validateEditToken($editToken);
    
    notifyArticleCreator($articleForDeletion, $remoteHost);
    my $afdUrl = setupDeletionDebatePage($articleForDeletion, $categoryForDeletion, $reasonForDeletion, $remoteHost);
    tagArticleWithDeletionNotice($articleForDeletion, $remoteHost, $afdUrl);
    logDeletionNomination($articleForDeletion, $remoteHost, $afdUrl);
    fileMaintenance($editToken);
    respondToUser($articleForDeletion, $afdUrl);
    return();
}

#______________________________________________________________________________#

sub checkForUnexpectedArgs {
    my @unexpectedArgs = @_;
    if (scalar(@unexpectedArgs) > 0) {
        error("Mismatch between expected and received number of arguments.");
    }
    return();
}

#______________________________________________________________________________#

sub checkFileCanBeAccessed {
    my($filePath,$requestType, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    if ($requestType eq "READ") {
        unless (-r $filePath) {
            error("The file $filePath cannot be read as requested.");
        }
    }
    elsif ($requestType eq "WRITE") {
        unless (-w $filePath) {
            error("The file $filePath cannot be written to as requested.");
        }
    }
    elsif ($requestType eq "EXISTS") {
        unless (-e $filePath) {
            error("The file $filePath does not exist.");
        }
    }
    else{
        error("Invalid file access method was chosen.");
    }
    return();
}

#______________________________________________________________________________#

sub fileMaintenance {
    my($editToken, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
   
    open(TOKENFILE, '+>', "$editTokenFile") or error("Cannot open edit token file."); # open for both read and write
    flock(TOKENFILE, 2)  or error("Cannot lock edit token file.");              
        my $fileContents = <TOKENFILE>;
        chomp($fileContents);
    
        my @allLines = split(/\n/, $fileContents);

        my $currentLineNumber = 0;
        my $matchLineNumber = 0;
        
        foreach my $line (@allLines) {
            my ($possibleMatchToken, $possibleMatchRemoteHost) = split(/\|/, $line);
            if ($possibleMatchToken eq $editToken) {
                $matchLineNumber = $currentLineNumber;
            }
            $currentLineNumber++;
        }
        
        splice(@allLines, $matchLineNumber, 1);
        
        foreach my $newLine (@allLines) {
            print TOKENFILE "$newLine\n";
        }
            
    flock(TOKENFILE, 8);        
    close (TOKENFILE) or error("Cannot close edit token file.");
    return ();
}

#______________________________________________________________________________#

sub respondToUser {
    my($articleName, $afdUrl, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $articleURL = uri_escape($articleName, "\0-\377");
    
    my $template = HTML::Template->new(filename => 'respondToUser.tmpl');
    $template->param(LANGUAGE => $language);
    $template->param(ARTICLEURL => $articleURL);
    $template->param(PATHTOIMAGES => $pathToImages);    
    $template->param(ARTICLENAME => $articleName); 
    $template->param(AFDURL => $afdUrl);
    
    print "Content-Type: text/html\n\n", $template->output;

    return();
}

#______________________________________________________________________________#

sub writeResultsToPage {
    my($replacement_page, $replacement_text, $replacement_summary, $additionalTextStyle, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);

    use LWP::UserAgent;
    my $agent=LWP::UserAgent->new;
    $agent->agent('Perlwikipedia/0.90');
    $agent->cookie_jar({file=> '.perlwikipedia-cookies'});

    my $login = HTTP::Request->new(POST => "http://$language.wikipedia.org/w/index.php?title=Special:Userlogin&action=submitlogin&type=login");
    $login->content_type('application/x-www-form-urlencoded');
    $login->content("wpName=$editorName&wpPassword=$editorPassword&wpRemember=1&wpLoginattempt=Log+in");
    my $logger_inner = $agent->request($login);
    my $do_redirect=HTTP::Request->new(GET =>'http://$language.wikipedia.org/w/index.php?title=Special:Userlogin&wpCookieCheck=login');
    my $redirecter= $agent->request($do_redirect);
    my $is_success=$redirecter->content;

    use HTML::Form;
    my $ua = LWP::UserAgent->new;
    $ua->agent("Perlwikipedia/0.90");
    $ua->cookie_jar($agent->cookie_jar());
    my $response = $ua->get("$replacement_page");
    my $form = HTML::Form->parse($response);
    
    my $existingText = $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;

    my $textToWrite = "";
    
    if ($additionalTextStyle eq "APPENDFIRST")
        {$textToWrite = $replacement_text . $existingText;}
    elsif($additionalTextStyle eq "APPENDLAST")
        {$textToWrite = $existingText . $replacement_text;}
    elsif ($additionalTextStyle eq "REPLACE")
        {$textToWrite = $replacement_text}
    else {error("Unrecognised wikipedia write request.");}

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

    return();
}

#______________________________________________________________________________#

sub logDeletionNomination {
    my($articleForDeletion, $remoteHost, $afdUrl, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $articleURL = uri_escape($articleForDeletion, "\0-\377");
    
    my ($day, $month, $year) = getCurrentDate();
    
    my $pageURL = "http://$language.wikipedia.org/w/index.php?title=Wikipedia:Articles_for_deletion/Log/" . $year . "_" . $month . "_" . $day . "&action=edit";
    my $contentToAdd = "{{subst:afd3 | pg=$articleForDeletion}}";
    my $editSummary = "Adding [[Wikipedia:$afdUrl]]";
    
    writeResultsToPage($pageURL, $contentToAdd, $editSummary, "APPENDLAST");
    return();
}

#______________________________________________________________________________#

sub getCurrentDate {
    my @months = qw(January February March April May June July August September October November December);
    my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
    my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime();
    my $currentYear = 1900 + $yearOffset; 
    my $currentMonth = $months[$month];
    return ($dayOfMonth, $currentMonth, $currentYear);
}

#______________________________________________________________________________#

sub setupDeletionDebatePage {
    my($articleForDeletion, $categoryForDeletion, $reasonForDeletion, $remoteHost, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);

    my $afdPage = "Articles_for_deletion/$articleForDeletion";
    my $numberOfPreviousNoms = getNoOfPreviousNoms($afdPage);
    my $currentNominationNumber = $numberOfPreviousNoms +1;
    
    my $afdPageToCreate = $afdPage . " (nomination $currentNominationNumber)";
    my $afdUrlToCreate = uri_escape($afdPageToCreate, "\0-\377");

    my $pageURL = "http://$language.wikipedia.org/w/index.php?title=Wikipedia:$afdUrlToCreate&action=edit";
    my $contentToAdd = "{{subst:afd2 | pg=$articleForDeletion | cat=$categoryForDeletion | text=$reasonForDeletion}} - [[User:$editorName|$editorName]] (on behalf of IP: $remoteHost) ~~~~~";
    my $editSummary = "Creating deletion discussion page for [[$articleForDeletion]] because $reasonForDeletion";
    
    writeResultsToPage($pageURL, $contentToAdd, $editSummary, "REPLACE");
    return($afdUrlToCreate);
}

#______________________________________________________________________________#

sub tagArticleWithDeletionNotice {
    my($articleForDeletion, $remoteHost, $afdUrl, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $articleURL = uri_escape($articleForDeletion, "\0-\377");
    
    my $pageURL = "http://$language.wikipedia.org/w/index.php?title=$articleURL&action=edit";
    my $contentToAdd = "{{subst:afd}}";
    my $editSummary = "nominated for deletion: see [[Wikipedia:$afdUrl]]";
    
    writeResultsToPage($pageURL, $contentToAdd, $editSummary, "APPENDFIRST");
    return();
}

#______________________________________________________________________________#

sub notifyArticleCreator {
    my($articleForDeletion, $remoteHost, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);

    my $articleCreator = fetchArticleCreator($articleForDeletion);
    
    my $pageURL = "http://$language.wikipedia.org/w/index.php?title=User_talk:$articleCreator&action=edit&section=new";
    my $contentToAdd = "{{subst:AFDWarning|$articleForDeletion}}  - [[User:$editorName|$editorName]] (on behalf of IP: $remoteHost) ~~~~~";
    my $editSummary = "Warning notification - $articleForDeletion proposed for deletion";
    
    writeResultsToPage($pageURL, $contentToAdd, $editSummary, "REPLACE");
    return();
}

#______________________________________________________________________________#

sub fetchArticleCreator {
    my($articleForDeletion, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $articleURL = uri_escape($articleForDeletion, "\0-\377");
    my $articleHistoryUrl = "http://en.wikipedia.org/w/index.php?title=$articleURL&dir=prev&action=history";
    
    my $browser = LWP::UserAgent->new();
    $browser->timeout(60);
    my $request = HTTP::Request->new(GET => $articleHistoryUrl);
    my $response = $browser->request($request);
    my $articleHistoryContents = $response->content();
    
    for ($articleHistoryContents) {
        s/[\s\S]*?<ul id="pagehistory">//;
        s/<\/ul>[\s\S]*/<br>/;
        s/<\/li>[\s\S]*?<li>/<br>/g;
        s/<li>//g;
        s/<\/li>//g;
        s/<input[\s\S]*?>//g;
        s/<a[\s\S]*?>//g;
        s/<\/a>//g;
        s/\(cur\)//g;       
        s/\(last\)//g;
        s/\(Talk \| contribs\)//g;       
        s/\(Talk\)//g;
        s/[\s\S]*?<span/<span/;
        s/<span class="minor">m<\/span>//g;
        s/<br>[\s\S]*?<span/<br><span/g;
        s/[\s]*?<\/span>/<\/span>/g;
        s/<\/span>[\s\S]*?<br>/<\/span><br>/g;
        s/<br>/\|/g;
        s/\|$//;
        s/^\|//;
        s/<span[\s\S]*?>//g;
        s/<\/span>//g;
        s/\n//g;
    }
       
    my @contributors = split(/\|/,$articleHistoryContents);
    reverse(@contributors);
    my $articleCreator = $contributors[0];
        
    return ($articleCreator);
}

#______________________________________________________________________________#

sub validateFilePaths {
    my($filePath, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    checkFileCanBeAccessed($editTokenFile, "EXISTS");
    checkFileCanBeAccessed($inputFormFile, "EXISTS");
    checkFileCanBeAccessed($errorFile, "EXISTS");
    checkFileCanBeAccessed($respondToUserFile, "EXISTS");
    
    return();
}

#______________________________________________________________________________#

sub validateCategoryCode {
    my($categoryForDeletion, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    unless (($categoryForDeletion eq "M") || ($categoryForDeletion eq "O") || ($categoryForDeletion eq "B") || ($categoryForDeletion eq "S") || ($categoryForDeletion eq "W") || ($categoryForDeletion eq "G") || ($categoryForDeletion eq "T") || ($categoryForDeletion eq "F") || ($categoryForDeletion eq "P") || ($categoryForDeletion eq "I") || ($categoryForDeletion eq "?")) {
        error("The category '$categoryForDeletion' that you entered is an invalid category code for the deletion debate.");
    }
    return()
}

#______________________________________________________________________________#

sub validatePageExists {
    my($articleForDeletion, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $articleContents = fetchPageContents($articleForDeletion);
    if ($articleContents =~ m/Wikipedia does not have an article with this exact name/) {
        error("The article '$articleForDeletion' that you nominated for deletion does not exist.");
    }
    return();
}

#______________________________________________________________________________#

sub getNoOfPreviousNoms {
    my($afdPage, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $noOfNominations = -1;
    my $afdPageExists = "true";
    until($afdPageExists eq "false") {
        $afdPageExists = "false";
        my $afdPagePossibility = $afdPage . " (nomination $noOfNominations)";
        $afdPageExists = validateAfdPageExists($afdPagePossibility);
        $noOfNominations++;
    }
    return ($noOfNominations);
}

#______________________________________________________________________________#

sub validateAfdPageExists {
    my($afdPage, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $articleContents = fetchPageContents($afdPage);
    
    my $afdPageExists = "false";
    
    if ($articleContents =~ m/Category:AfD debates/) {
        $afdPageExists = "true";
    }
    return($afdPageExists);
}

#______________________________________________________________________________#

sub fetchPageContents {
    my($article, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    $article = uri_escape($article, "\0-\377");
    
    my $article_url = "http://$language.wikipedia.org/wiki/$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.
    
    $article = uri_unescape $article;
    
    return($contents);
}

#______________________________________________________________________________#

sub validateBasicFormats {
    my($editToken, $articleForDeletion, $categoryForDeletion, $reasonForDeletion, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
   
    unless (($editToken =~ m/\S+/)  && ($articleForDeletion =~ m/\S+/) && ($categoryForDeletion =~ m/^\S{1}$/) && ($reasonForDeletion =~ m/\S+/)) {
        error("You returned one or more empty or invalid fields, this is not permitted, all fields are mandatory.");
    }
    return();
}

#______________________________________________________________________________#

sub validateEditToken {
    my($offeredToken, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $fileContents = readEditTokens();
    chomp($fileContents);
    my @allLines = split(/\n/, $fileContents);
    my $tokenFound = 0;
    my $actualHost = "";
    foreach my $line (@allLines) {
        my ($editToken, $remoteHost) = split(/\|/, $line);
        if ($offeredToken eq $editToken) {
            $tokenFound++; $actualHost = $remoteHost;
        }
    }
    unless ($tokenFound > 0) {
        error("The edit token '$offeredToken' that you provded is an invalid edit token.");
    }
    return($actualHost);
}

#______________________________________________________________________________#

sub readEditTokens {

    open(TOKENFILE, '<', "$editTokenFile") or error("Cannot open edit token file.");
        flock(TOKENFILE, 2)  or error("Cannot lock edit token file.");              
        my $editTokens = <TOKENFILE>;
        flock(TOKENFILE, 8);        
    close (TOKENFILE) or error("Cannot close edit token file.");
    return ($editTokens);
}

#______________________________________________________________________________#

sub generateEditToken {
    my($remoteHost, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $timeNow = time();
    my $stringForEncryption = $remoteHost . $timeNow;
    my $editToken = crypt($stringForEncryption,"a3");
    writeTokenToFile($editToken, $remoteHost);
    return ($editToken);
}

#______________________________________________________________________________#

sub writeTokenToFile {
    my($editToken, $remoteHost, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);
    
    my $stringToWrite = $editToken . "|" . $remoteHost;

    open(TOKENFILE, '>>', "$editTokenFile") or error("Cannot open edit token file.");
        flock(TOKENFILE, 2)  or error("Cannot lock edit token file.");            
            print TOKENFILE "$stringToWrite\n";
        flock(TOKENFILE, 8);        
    close (TOKENFILE) or error("Cannot close edit token file.");
    return();
}

#______________________________________________________________________________#

sub printInputForm {
    my($editToken, @unexpectedArgs) = @_;
    checkForUnexpectedArgs(@unexpectedArgs);

    my $template = HTML::Template->new(filename => 'inputForm.tmpl');
    $template->param(PATHTOIMAGES => $pathToImages);
    $template->param(PATHTOSCRIPT => $pathToScript);
    $template->param(EDITTOKEN => $editToken);
    
    print "Content-Type: text/html\n\n", $template->output;

    return();
}

#______________________________________________________________________________#

sub error {
    my $template = HTML::Template->new(filename => 'error.tmpl');
    $template->param(ERROR => $_[0]);
    print "Content-Type: text/html\n\n", $template->output;
    exit;
}