User:PockBot/SourceCode/114

$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;

  }

  my @found_articles = split(/\|/,$content_articles);

  return (@found_articles);

  }

  1. ______________________________________________________________________________#

  sub getSubCatsinCategory {

  my $content_subcats = $_[0];

  # if its not a wikipedia category page, empty array

  unless ($content_subcats =~ m/

  /){

  $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]*

  //;

  $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]*?

  /
  /;

  $content_subcats =~ s/

  //g;

  $content_subcats =~ s/<\/ul>//g;

  $content_subcats =~ s/<\/li>/|/g;

  $content_subcats =~ s/

  • /|/g;

    $content_subcats =~ 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;

    }

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

    return (@found_subcats);

    }

    1. ______________________________________________________________________________#

    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 "

    Thank you for using PockBot. You have requested a list of article classes for ";

    print " wikipedia category $category.

    ";

    print "

    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 category's talk page.
    
    ";

    print "If your browser times out you may get a blank page, The data will still be written as requested and not affected by this.

    ";

    print "

    Progress:
    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 "";} });

    $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.");

    }

    }

    }

    1. ______________________________________________________________________________#

    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);

    }

    1. ______________________________________________________________________________#

    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);

    }

    1. ______________________________________________________________________________#

    sub removeImages {

    my @articles_no_duplicates = @_;

    my @articles_no_images = ();

    foreach my $article (@articles_no_duplicates) {

    # don't count iamges, categories or templates

    unless (($article =~ m/Image:/) || ($article =~ m/Category/) || ($article =~ m/Template/)) {

    push(@articles_no_images, $article);

    }

    }

    return (@articles_no_images);

    }

    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;

    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)

    }

    1. ______________________________________________________________________________#

    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.");

    }

    }

    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 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 $userRunningBot";

    }

    my @subcats = getSubCatsinCategory($contents);

    my @articles = getArticlesinCategory($contents);

    my $new_subcats_found_this_round = 1;

    my @subcats_searched_aleady = ();

    my $subCatLimit = 500;

    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.
    
    ";

    }

    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";

    }

    1. ______________________________________________________________________________#

    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);

    }

    1. ______________________________________________________________________________#

    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);

    }

    1. ______________________________________________________________________________#

    sub finishedRunning {

    my $category = $_[0];

    my $category_url = "http://en.wikipedia.org/wiki/Category_talk:" . $category;

    print "
    Finished (Run again for another category).

    ";

    &printFooter;

    }

    1. ______________________________________________________________________________#

    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);

    }

    1. ______________________________________________________________________________#

    sub enableBot {

    open(STATUSFILE,"$status_file") || &error("Cannot open bot status file.");

    flock(STATUSFILE, 2) || &error("Cannot lock bot status file.");

    my $current_status = ;

    flock(STATUSFILE, 8);

    close (STATUSFILE);

    chomp($current_status);

    my $bot_enabled = $current_status;

    if ($bot_enabled == 1) {

    &printOnlineHeader;

    print "

    PockBot is already enabled. Disable PockBot

    ";

    &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 "

    PockBot is now enabled. Disable Pockbot

    ";

    &printFooter;

    exit;

    }

    else {

    &error("Unrecognised bot status. Something has gone wrong.");

    }

    }

    1. ______________________________________________________________________________#

    sub disableBot {

    open(STATUSFILE,"$status_file") || &error("Cannot open bot status file.");

    flock(STATUSFILE, 2) || &error("Cannot lock bot status file.");

    my $current_status = ;

    flock(STATUSFILE, 8);

    close (STATUSFILE);

    chomp($current_status);

    my $bot_enabled = $current_status;

    if ($bot_enabled == 0) {

    &printOfflineHeader;

    print "

    PockBot is already disabled. Enable PockBot

    ";

    &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 "

    PockBot is now disabled. Enable Pockbot

    ";

    &printFooter;

    exit;

    }

    else {

    &error("Unrecognised bot status. Something has gone wrong.");

    }

    }

    1. ______________________________________________________________________________#

    sub checkIfBotOnline {

    open(STATUSFILE,"$status_file") || &error("Cannot open bot status file.");

    flock(STATUSFILE, 2) || &error("Cannot lock bot status file.");

    my $current_status = ;

    flock(STATUSFILE, 8);

    close (STATUSFILE);

    chomp($current_status);

    my $bot_enabled = $current_status;

    if ($bot_enabled == 0) {

    &printOfflineHeader;

    print "

    PockBot is currently disabled. If you are certain it has not been disabled for a reason, you can Enable PockBot

    ";

    &printFooter;

    exit;

    }

    elsif ($bot_enabled == 1) {

    #no action necessary

    }

    elsif ($bot_enabled == 2) {

    &printOfflineHeader;

    print "

    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.

    ";

    &printFooter;

    exit;

    }

    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 "";

    print "Wikipedia > Pockbot's User Page
    ";

    print "Pockbot is currently ONLINE / ENABLED (Disable PockBot)
    ";

    print "
    ";

    my$currentServerLoad = getWikipediaLoad();

    print "";

    }

    1. ______________________________________________________________________________#

    sub printOfflineHeader {

    print "Content-type: text/html\n\n";

    print "";

    print "

    Wikipedia > Pockbot's User Page

    ";

    print "

    Pockbot is currently OFFLINE / DISABLED (Enable PockBot)

    ";

    print "";

    }

    1. ______________________________________________________________________________#

    sub printFooter {

    print "";

    }

    1. ______________________________________________________________________________#

    sub error {

    &printOnlineHeader;

    print "

    ERROR: $_[0]

    ";

    &printFooter;

    exit;

    }