User:H/Real time contribution watcher

This script will allow you to watch contributions of users in real time. You need to have perl installed, and the NET::IRC module installed. Pick a name and place it in the $bot_name variable, and add names of people who you want to watch to the @targets variables. Make sure the $browser_path variable points to your browser of choice, use 2 \\ to represent a single \.

use strict; use Net::IRC; use URI::Escape;
 * 1) This script is released under the GFDL license

our($browser_path) = 'C:\\Program Files\\Mozilla Firefox\\firefox.exe'; our(@users) = ( # You can add and remove names here, put a "\" before single quotes "'" 'H', ); our(@pages) = ( 'User talk:H', 'Wikipedia:Featured picture candidates/British Columbia Parliament Buildings', );

warn ("Watching users:\n\n".join("\n",@users)."\n\n"); warn ("Watching pages:\n\n".join("\n",@pages)."\n\n");

my $version_number = '0.01b'; my $VERSION = 'Real time contrib watcher v'.$version_number; my($on_server,@job_list); my $timing = 0;


 * 1) IRC connection setup

my $server             = 'irc.wikimedia.org';          # The irc server your bot is to reside my $port               = 6667;                         # The port of above mentioned server my $bot_name           = 'pickaname';                # The nick for the bot my @channels           = ('#en.wikipedia');            # The channel(s) to connect to my $reconnect_delay     = 30;                           # Time to wait after disconnect to reconnect (In Seconds) my $irc = new Net::IRC;                                # Net::IRC our master IRC object warn "Connecting to IRC...\n"; my $conn = $irc->newconn(                                   #|Connect to the server                         Nick           => $bot_name,                #|                         Server         => $server,          #|                         Port           => $port,            #|                        ); $conn->add_handler  ('endofmotd'    => \&on_connect);        # Set off by a connect to server $conn->add_handler  ('disconnect'   => \&on_disconnect);     # Set off when connection to server is lost $conn->add_handler  ('public'       => \&on_public); # Set off by public messages


 * 1) Program loop

until (1==2) { sleep(.1); $irc->do_one_loop; my (@kept_jobs);                     # A place to put jobs not ready to run yet while (my $job = shift(@job_list))   # Go through each job pending {   my($r_job, $timing) = @{$job}; if ($timing < time)              # If it is time to run it then run it      { if (ref($r_job) eq 'ARRAY')      # Callback style, reference to an array with a sub followed by paramaters {       my $cmd = shift(@{$r_job}); &{$cmd}(@{$r_job}); }     elsif (ref($r_job) eq 'CODE')     # Otherwise just the reference to the sub {       &{$r_job}; }     }    else                                # If it is not time yet, save it for later {     push(@kept_jobs, $job) }   }  push (@job_list, @kept_jobs);        # Keep jobs that are still pending }

sub add_job    # Command to add a job to the queue { my ($r_job, $timing) = @_; push (@job_list, [$r_job , (time+$timing)]); }


 * 1) ___________________IRC_triggered_subs___________________#

sub on_connect # triggered when motd is done... otherwords when you connect to server. { my $self      = shift; my $event    = shift; warn "Connected to IRC server '$server:$port' as '$bot_name'.\n"; foreach my $chan (@channels) {   add_job([\&get_on_channel, $self , lc($chan)] , 0); } $on_server = 1; }

sub get_on_channel { my $self      = shift; my $chan     = shift;

$chan = lc($chan); warn "Attempting to join $chan.\n"; my $response = $self->join($chan);                                                # try to join channel die("Got join response of: $response\n") unless ($response == 20); warn "Joined.\n\n"; }

sub on_public { my $self      = shift; my $event    = shift;

my $statement = ${$event->{'args'}}[0]; my $esc = chr(0x03); my $name_pattern = $esc.'03(.*?)'.$esc; my $article_pattern = 'title=(.*?)&'; my $url_pattern = $esc.'02(.*?)'.$esc; $statement =~ m|$name_pattern|i; my $match = 0; foreach my $target (@users) {   $match = 1 if ($1 eq $target); } $statement =~ m|$article_pattern|i; my $article = uri_unescape($1); $article =~ s|_| |g; foreach my $page (@pages) {   $match = 1 if (lc($page) eq lc($article)); } return unless ($match); return if ($statement =~ m|07Special:Log|); $statement =~ m|$url_pattern|i; warn $statement; my $url = $1; system (    $browser_path,     $url    ); warn "Edit: $url\n"; }

sub on_disconnect # triggered when server connection is lost. { my $self      = shift; my $event    = shift;

my $reason = ${$event->{'args'}}[0]; warn "Connection lost:".$reason."\n"; warn "Waiting $reconnect_delay seconds before reconnecting to avoid hammering.\n"; ($on_server) = (undef, undef); sleep($reconnect_delay);     # Avoid getting hammer-blocked by waiting before reconnect. warn "Attempting to reconnect to $server:$port\n"; until ($self->connect){print "Retry...\n"} # Start again from the beggining by reconnecting, uses same logfile }