#!/usr/local/bin/perl -w
use strict;
use WWW::Mechanize;
use Getopt::Long;
use Data::Dumper;

# Parse command line arguments and assign corresponding variables
GetOptions
(
    'q|question=s' => \( my $QUESTION = undef),
    'f|format=s'   => \( my $FORMAT   = 'TEXT' ),
    'v|verbose'    => \( my $VERBOSE  = 0 ),
);

unless ( defined $QUESTION && $FORMAT =~ /^(text|html)$/i )
{
    print <<USAGE
Description: Ask the MIT AI (START) a question and get some answer.
             Just for fun of course. ;-)

Usage: $0 [option]
Options:
  -q|--question ["text"]    Question to ask AI
  -f|--format [TEXT|HTML]   The output format. Default is TEXT.
  -v|--verbose              Print more info

USAGE
;
    exit(1);
}

my $URL = "http://www.ai.mit.edu/projects/infolab/";
$FORMAT = uc $FORMAT;

print ">> Asking START the question:\n" .
      ">> $QUESTION\n" if $VERBOSE;

my $robot = new WWW::Mechanize;

print ">> Fetching query form...\n" if $VERBOSE;
$robot->get($URL);

print ">> Submitting query...\n" if $VERBOSE;
$robot->form_number('1');
$robot->set_fields('query' => $QUESTION);  # ask a question
$robot->click();

# Get the reply to my question
print ">> Fetching answer...\n" if $VERBOSE;
my $html = $robot->content();

# Extract the answer
my ($text) = $html =~
   /(<H1>START(?:.|\n)*(?:<HR>|line-rain.gif" width=100% height=3>))/m
+;

if (!defined $text || $text =~ /^\s+$/) {
    $text = NoAnswer();
}

if ($FORMAT eq 'TEXT') {
    # Reformat the text
    $text =~ s/(<\/P>|<br>|<li>|<option>)/\n\n/gi; # Add some \n's
    $text =~ s/<[^>]*>//g;              # Strip HTML tags
    $text =~ s/<!--|-->//mg;            # Strip comments

    $text =~ s/&gt;/>/g;                # Quick and dirty fix
    $text =~ s/&lt;/</g;
    $text =~ s/&nbsp;/ /g;
    $text =~ s/&amp;/&/g;
    $text =~ s/&eacute;/e/g;

    $text =~ s/^[^\S\n]+//mg;           # Strip leading spaces
    $text =~ s/(?<=\n)\n+/\n/mg;        # Squash multiple empty lines
    $text =~ s/(?<!\n)\n(?!\n)/ /mg;    # Combine lines
    $text =~ y/\t / /s;                 # Squash multiple spaces & tab
+s

    # after some playing around, I came up with the
    # following regex that does wrapping at column
    # 60 perfectly. I love perl. ;-)

    $text =~ s/(.{50,60}(?<=\s\b))/$1\n/mg;
}

print "$text\n";

exit(0);

sub NoAnswer
{
    my @responses = (
        'is silent',
        'looks puzzled',
        'refuses to give an answer',
        'shakes his head',
        'gives no answer',
        'could not understand the question',
        'says: please try again',
        'is currently off-line',
        'Ur?',
        'Which question?',
        'Why?',
        'Can you repeat the question again?',
        'May I have your name please?',
        'I am just a robot, what do you expect?',
        'Please ask a different question',
    );

    print Dumper(\@responses) if $VERBOSE;

    my $r = $responses[rand($#responses+1)];
    $r = 'START ' . $r if $r =~ /^[a-z]/;
    $r =~ s/([^\?])$/$1./;

    return $r;
}
[download]