ed reimplementation contest

Let's reimplement ed with modern languages!

10 INPUT
20 PRINT "?"
30 GOTO 10

[code]
#!/usr/bin/perl
#
#       interjection.pl
#
#   Run in a loop, automating the following sequence of actions:
#
#   1.  Scan front page of selected boards, collect list of threads.
#   2.  Scan thread for erroneous usage of "Linux", in the context of
#       describing a complete operating system.
#   3.  Interject with random Stallman picture and apt pasta, then sleep.
#   4.  At the end of each sweep, sleep for a few minutes before repeating
#       again, ad nauseam.

use warnings;
use strict;

use LWP::UserAgent;
use HTML::Form;
use Data::Dumper;
use DateTime;


my @threads;

my $iteration = 0;
my %boards = ( g => 'zip' );                        # Hash containing boards to sweep.
my $log_file = "$ENV{HOME}/log_interjection";       # Log file location
my @ns_headers = (
    'User-Agent' => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.0.9) Gecko/2009050519 Iceweasel/3.0.9 (Debian-3.0.9-1)',
    'Accept-Charset' => 'iso-8859-1,*,utf-8',
    'Accept-Language' => 'en-US',
);

our $logging_enabled = 1;
our $pic_path = "/mu-nfs/pic/stallman/";            # Directory holding delicious Stallman pictures
our $scan_interval = 240;                           # Interval between each sweep of all boards
our $min_post_interval = 30;                        # Minimum delay after each individual interjection
our $post_interval_variation = 15;                  # Upper threshold of random additional delay after interjecting

our $total_posts = 0;
our @handsome_rms_pics = <$pic_path*>;
our @interjected;                                   # Track posts already responded to.
our $browser = LWP::UserAgent->new;
our $rms_pasta =<<FIN;

open LOGGING, ">", $log_file or die $!;  
print LOGGING "...logging to $log_file\n";



&log_msg("### ------------ interjection.pl ------------ ###");
&log_msg("###");
&log_msg("### \$pic_path:\t\t\t$pic_path");
&log_msg("### \$scan_interval:\t\t$scan_interval");
&log_msg("### \$min_post_interval:\t\t$min_post_interval");
&log_msg("### \$post_interval_variation:\t$post_interval_variation");
&log_msg("###");
&log_msg("### ----------------------------------------- ###");
&log_msg("Entering main loop...");

while (1) {
    &log_msg("Iteration $iteration");
    for (sort keys %boards) {
        # Aggregate listing of threads on front page of board,
        # pass each thread to &scan_posts to read.

        my ($srvr, $board) = ($boards{$_}, $_);
        my $board_url = "http://$boards{$board}.4chan.org/$board/imgboard.html";
        my $page = ($browser->get($board_url, @ns_headers))->content;
        $@ and print STDERR "$!\n";
        push @threads, $page =~ /<span id="nothread(\d+)">/g;

        &scan_posts("http://$srvr.4chan.org/$board/res/$_.html") for @threads;
    }

    &log_msg("Ending iteration $iteration. Will resume in $scan_interval seconds.\n");
    sleep($scan_interval);  # long pause between sweeps.
    $iteration++;
}

sub scan_posts {
    my $thread_url = shift;
    my %posts;
    my $page = ($browser->get($thread_url, @ns_headers))->content;


    # 'name' attribute holds post number, post body is inside blockquote tags.
    %posts = $page =~
        /<a name="(\d+)"><\/a>.*?<blockquote>(.*?)<\/blockquote>/gs;


    for my $no (sort keys %posts) {
        $_ = $posts{$no};
              
        # Strip any remaining tags in post body.
        s/<.*?>.*?<\/.*?>//g;
        s/<.*?>//g;


        # If post contains 'Linux' or some obvious variant, not followed
        # by 'kernel' **AND** no mention of GNU/Linux or GNU plus Linux,
        # then respond.

        if (/L\s*                                   # (L)inux
                (
                    [1i]\W*n\W*u\W*             |   # L(inu)x
                    u\W*n\W*[1i]\W*             |   # L(uni)x
                    [0o]\W*[0o]\W*n\W*[1i]\W*       # L(ooni)x
                )
            x                                       # Linu(x)
            (?!\s+kernel)/ix
                && ! /GNU\s*(\/|plus|with|and|\+)\s*(Linux|Lunix)/i) {

            my $transpose = $1 =~ /u\s*n\s*i\s*/i;
            next if grep {$_ == $no} @interjected;

            &log_msg("URL: $thread_url post: $no");
            &log_msg("POST: $_");
            &log_msg("* Transposed! *") if $transpose;

            &interject($thread_url, $no, $page, $transpose);
            push @interjected, $no;
            $total_posts++;
            &log_msg("Interjection to post $no successful. Freedom delivered! Total posts: $total_posts");
        }
    }
}

sub interject {
    # Prepare pasta, fill form fields, find submit
    # button and click it, then sleep for a semi-
    # random amount of time.

    my ($url, $post_no, $page, $transpose) = @_;
    my ($form, $interjection, $submit_button, $pic);

    $interjection = ">>$post_no\n\n" . $rms_pasta;
    $interjection =~ s/Linux/Lunix/g if $transpose;
    $pic = &select_pic;
    &log_msg("attached pic: $pic"); 

    $form = HTML::Form->parse($page, $url);
    $form->value('com', $interjection);
    $form->value('upfile', $pic);
    $submit_button = (grep {$_->type eq 'submit'} $form->inputs)[0];
    $browser->request($submit_button->click($form));

    sleep($min_post_interval + rand($post_interval_variation));
}

sub log_msg {
    my $msg = shift;
    exit if ! $logging_enabled;
    my $now = DateTime->now;
    syswrite LOGGING, $now->ymd . " " . $now->hms . ": $msg\n" or die $!;
}

sub select_pic {
    # Select a file from the array and remove its entry.

    &log_msg("No more sexy RMS pictures left... ;_;\n") && exit if ! @handsome_rms_pics;
    return splice @handsome_rms_pics, int(rand(@handsome_rms_pics)), 1;
}
[code]