#!/usr/bin/perl
use DBI;
use DBD::mysql;
use LWP::UserAgent;
use HTTP::Request::Common qw(GET);
use CGI::Enurl;
use HTTP::Cookies;
use HTML::Entities;
use Mail::Sendmail;

### PREPARE VARIABLES

%table = %pp = %mm = %tt = %backlink = @ebresponse = ();
$info = "timestamp: ".time." pid: $$ Message-Id:";

$muffin = "adik-parser\@ilovebacon.org";
$gdpb = "d-pittsburgh-bullcrap\@googlegroups.com";
$camefrom = $origsubject = $subject = $crosspost = "";
my $showlinks;

$display = $scores = $newlinks = $unlinks = undef;

$sig = "
---------------------------------
The Parser, Version 3.5.3
Better living through pedantry
http://parser.ilovebacon.org
";
$respond_to = $date = "";
my $q;
@eightball = %unlinkme = ();

### Scan message, yoink some info, wait for content.

$quoted = "";

while (<>) {
  if (/^X-From-(?:Yahoo|Google)/) { exit 0; }
  elsif ( /^Subject: (.*)/ ) {
    $origsubject = $1;
    unless ($origsubject =~ /^Re:/) {
      $origsubject = "Re: ".$origsubject;
    }
  }
  elsif ( /^From: (.*)/ ) {
    $respond_to = $1;
    $quoted = "On ".scalar(localtime(time)).", $respond_to said:\n\n";
  }
  elsif ( /^Date: \w\w\w, (\d\d? \w\w\w \d\d\d\d \d\d:\d\d:\d\d)/) {
    $date = $1;
  }
  elsif ( /^Message-Id: (.*)/i ) {
    $info .= " $1\n";
  }
  elsif ( /^To: (.*)/ ) {
    $t = $1;
    if ($t =~ /bullcrap\@googlegroups\.com/) {
      $camefrom = "Google";
      $postfrom = $gdpb;
    }
    else { exit 0; }
  }
  elsif ( /^$/ ) { last; }
}

### Skim through, line-by-line.
@getdefs = ();

@lines = ($origsubject,<STDIN>);

foreach $line (@lines) {
  chomp $line;
  $quoted .= "> $line\n";
  if ( $line =~ /^[>:\|]/ ) { next; } ### Ignore quotes. Also an angry yelling dude.
  if ( $line =~ /^Content-Type: Text\/HTML/i ) { ### Hates the HTML email.
#    $message = "HEY! EVERYONE! $respond_to POSTED IN HTML!\n";
#    $dumb = $respond_to;
#    $dumb =~ s/.*?([^\(\)\<\>\@\,\:\;\\\"\[\]]+?\@[\w\d\.-]+).*/$1/;
#    $message .= "$dumb-- for that. Fool. You should now make sure $dumb is
#linked to whoever $dumb really is.\n$sig";
#    mySendmail($postfrom,"$dumb posts in HTML!",$message);
    exit 0;
  }
  elsif ( $line =~ /^Yahoo\! Groups Links$|(?:- Yahoo\! Groups Sponsor -)/ ) { last; } ### Don't parse ads.
  if ($line =~ /parser\.8-?ball (.*)/i ||
      $line =~ /parser\.eightball (.*)/i ||
      $line =~ /parser\.divine (.*)/i ) {  ### Detect 8-ball, save q
    push(@eightball,$1);
  }
  if ( $line =~ /parser\.winning/i ) {
    mySendmail($postfrom,$origsubject,"MUFFIN is winning this argument.\n\n$quoted\n\n$sig");
  }    
  if ( $line =~ /\bUS\d{10}\b/i ) { ### Posting your Cam number is sad.
    $message = "HEY! EVERYONE! $respond_to POSTED THEIR CAM NUMBER!\n";
    $dumb = $respond_to;
    $dumb =~ s/.*?([^\(\)\<\>\@\,\:\;\\\"\[\]]+?\@[\w\d\.-]+).*/$1/;
    $message .= "$dumb-- for that. That's just sad, man.
Megin would kick your ass. People should now make sure $dumb is
linked to whoever $dumb really is.\n$sig";
    mySendmail($postfrom,"$_ posted their cam number!",$message);
  }
  if ($line =~ /parser\.link\s+(\S+)\s+(\S+)\s*/i) { ### D links
    if (lc($1) ne lc($2)) {
      $linkdb{lc($1)}{lc($2)} = 1;
      $newlinks .= uc($1)." is now linked to ".uc($2)."\n";
      $added = 1;
      $tt{lc($1)} = 1;
    }
  }
  if ($line =~ /parser\.reflink\s+(\S+)\s+(\S+)\s*/i) { ### reflexive D links
    if (lc($1) ne lc($2)) {
      $linkdb{lc($1)}{lc($2)} = 1;
      $linkdb{lc($2)}{lc($1)} = 1;
      $newlinks .= uc($1)." is now linked to ".uc($2)."\n";
      $newlinks .= uc($2)." is now linked to ".uc($1)."\n";
      $tt{lc($1)} = 1;
      $tt{lc($2)} = 1;
      $added = 1;
    }
  }
  if ($line =~ /parser\.neglink\s+(\S+)\s+(\S+)\s*/i) { ### D links
    if (lc($1) ne lc($2)) {
      $linkdb{lc($1)}{lc($2)} = -1;
      $newlinks .= uc($1)." is now negatively linked to ".uc($2)."\n";
      $added = 1;
      $tt{lc($1)} = 1;
    }
  }
  if ($line =~ /parser\.(?:negref|refneg)link\s+(\S+)\s+(\S+)\s*/i) { ### reflexive D links
    if (lc($1) ne lc($2)) {
      $linkdb{lc($1)}{lc($2)} = -1;
      $linkdb{lc($2)}{lc($1)} = -1;
      $newlinks .= uc($1)." is now negatively linked to ".uc($2)."\n";
      $newlinks .= uc($2)." is now negatively linked to ".uc($1)."\n";
      $tt{lc($1)} = 1;
      $tt{lc($2)} = 1;
      $added = 1;
    }
  }
  if ($line =~ /parser\.unlink\s+(\S+)\s+(\S+)\s*/i) { ### D unlinks
    if (lc($1) ne lc($2)) {
      $a = lc($1);
      $b = lc($2);
      $a =~ s/\'/\\\'/g;
      $b =~ s/\'/\\\'/g;
      $unlinkme{$a}{$b} = 1;
      $unlinks .= uc($1)." is as of now not linked to ".uc($2)."\n";
      $tt{lc($1)} = 1;
    }
  }
  if ($line =~ /parser\.refunlink\s+(\S+)\s+(\S+)\s*/i) { ### D unlinks
    if (lc($1) ne lc($2)) {
      $a = lc($1);
      $b = lc($2);
      $a =~ s/\'/\\\'/g;
      $b =~ s/\'/\\\'/g;
      $unlinkme{$a}{$b} = 1;
      $unlinkme{$b}{$a} = 1;
      $unlinks .= uc($1)." is as of now not linked to ".uc($1)."\n";
      $unlinks .= uc($2)." is as of now not linked to ".uc($1)."\n";
      $tt{lc($1)} = 1;
      $tt{lc($2)} = 1;
    }
  }
  if ($line =~ /parser\.links(\s+\/.*\/)?/i) { ### D link list requests
    $showlinks = (split(/\//,$1))[1];
  }
  if ($line =~ /parser\.define\s+(.*)/i) { # Define the rest of the line
    push(@getdefs,$1);
  }
#  print STDERR "line: $line\n";
  if ( $line =~ /parser\.query\s*(.*)/i ) { ### Detect query reqs.
    $query = $1;
    $query =~ s/\/(.*)\//$1/;
    $query = '.' unless $query;
#    print STDERR "YES; query is now \"$query\"\n";
  }
  if ( $line =~ /parser\.context\s*(\S*)\s?/i ) {
#    print STDERR "$&\n";
    $cxt{lc($1)} = 1;
  }
  if (defined $thislink && $line =~ /.*!.*!.*/) {
    $tags = $line;
    if ($date =~ /(..?) (...) (....) (..:..:..)/) {
      $linkdate .= $3;
      $mon = "01" if $2 eq "Jan";
      $mon = "02" if $2 eq "Feb";
      $mon = "03" if $2 eq "Mar";
      $mon = "04" if $2 eq "Apr";
      $mon = "05" if $2 eq "May";
      $mon = "06" if $2 eq "Jun";
      $mon = "07" if $2 eq "Jul";
      $mon = "08" if $2 eq "Aug";
      $mon = "09" if $2 eq "Sep";
      $mon = "10" if $2 eq "Oct";
      $mon = "11" if $2 eq "Nov";
      $mon = "12" if $2 eq "Dec";
      $linkdate .= "-$mon-";
      $linkdate .= (length $1 == 1 ? "0$1 " : "$1 ").$4;
    }
    foreach (qw(linkdate respond_to thislink tags)) {
      ${$_} =~ s/\\/\\\\/g;
      ${$_} =~ s/\"/\\\"/g;
    }
    $str = "insert into links (date,poster,address,tags) values (\"$linkdate\",\"$respond_to\",\"$thislink\",\"$tags\");";
    ($u,$p) = split(/\t/,(`cat /home/parser/dbaccess`)[0]);
    chomp $p;
    $db = DBI->connect("DBI:mysql:dpb:feta.ilovebacon.org",$u,$p)
      or mySendmail($muffin,"Could not connect to db.","arggh\n".$db->errstr."\n$str\n");
    $db->{RaiseError} = 1;
    $sth = $db -> prepare($str);
    $sth->execute or mySendmail($muffin,"Could not add link to db",$db->errstr."\n");
    $sth->finish;
    $db->disconnect;
  }
  else { undef $thislink; }
  @words = split(/\s+/,$line); ### Split line into words.
  foreach $word (@words) {
    if ( $word =~ /(.+)\+\+([\.\,\!\?\"\]\)]$|$|\'s$)/ 
      || $word =~ /(.+)plusplus([\.\,\!\?\"\]\)]$|$|\'s$)/ ) { ### Plusplus
      $tmp = $1;
      if ( $tmp =~ /[^\+]/ ) {
        $tmp =~ s/^\"// unless $tmp =~ /\"$/;
        $tmp =~ s/^\[// unless $tmp =~ /\]$/;
        $tmp =~ s/^\(// unless $tmp =~ /\)$/; 
        $pp{lc($tmp)} = 1;
      }
    }
    elsif ( $word =~ /^(?!--)(.*[^-])--([\.\,\!\?\]\"]$|$|\'s$)/
         || $word =~ /(.+)minusminus([\.\,\!\?\]\"]$|$|\'s$)/ ) { ### Minusminus
      $tmp = $1;
      $tmp =~ s/^\"// unless $tmp =~ /\"$/;
      $tmp =~ s/^\[// unless $tmp =~ /\]$/;
      $mm{lc($tmp)} = 1;
    }
    elsif ( $word =~ /(.+[^~])~~([\.\,\!\?\"\]]$|$|\'s$)/ ) {
      $tmp = $1;
      $tmp =~ s/^\"// unless $tmp =~ /\"$/;
      $tmp =~ s/^\[// unless $tmp =~ /\]$/; 
      $tt{lc($tmp)} = 1;
    }
    elsif ( $word =~ /~~(.+[^~])$|$|\'s$/ ) {
      $tmp = $1;
      $tmp =~ s/^\"// unless $tmp =~ /\"$/;
      $tmp =~ s/^\[// unless $tmp =~ /\]$/; 
      $backlink{lc($tmp)} = 1;
    }
    elsif ( $word =~ /^http/i ) { ### Look for a link
      $thislink = $word;
    }
  }
}

### Figure out what needs to happen and why.
$change = scalar(keys %pp) + scalar(keys %mm) > 0;
$chlnk = scalar (keys %unlinkme) > 0 || $added;
$display = $chlnk || $showlinks || $change || $query || scalar(keys %tt) > 0 || scalar(@eightball) > 0 || scalar(keys %cxt) > 0 || scalar(keys %backlink) > 0;
$displink = $display;

exit 0 unless $display;

if (scalar(keys %cxt) > 0) {
  $db = DBI -> connect("DBI:mysql:dpb:host=swiss.ilovebacon.org","bullcrap","bullcrap");
  $db->{RaiseError} = 1;
  $db->do("CREATE TEMPORARY TABLE tmp.theseitems (item varchar(20000));") or die $db->errstr;
  $sth = $db->prepare_cached("INSERT INTO tmp.theseitems (item) VALUES (?)");
  foreach (keys(%cxt)) {
#    print STDERR "key: $_";
    $sth->execute($_) or die $db->errstr;
  }
  $sth->finish;
  $sth = $db->prepare("SELECT distinct(messageID),karmacontext.item FROM karmacontext JOIN tmp.theseitems ON tmp.theseitems.item=karmacontext.item ORDER BY item,messageID DESC");
  $sth->execute  or die $db->errstr;
  $lastitem = $message = "";
  while ( ($messageID,$item) = $sth->fetchrow_array ) {
#    print STDERR "id $messageID item $item\n";
    if ($item ne $lastitem) {
      if ($message ne "") {
        $message .= makeashorterlink($url);
#        print STDERR "url $url\n";
      }
      $message .= "\n\nContext for $item:\n  ";
      $url = "http://parser.ilovebacon.org/dbaccess/index.cgi?id=$messageID";
      $lastitem = $item;
    }
    else {
      $url .= "&id=$messageID";
    }
  }
  if ($message ne "") {
    $message .= makeashorterlink($url);
#    print STDERR "url $url\n";
  }
  $sth->finish;
  $db->disconnect;
  $message .= "\n$sig";
  mySendmail($postfrom,"Parser context request",$message);
}

### Connect to db
($u,$p) = split(/\t/,(`cat /home/parser/dbaccess`)[0]);
chomp $p;
$db = DBI -> connect("DBI:mysql:parser:host=localhost;port=3306",$u,$p)
  or print "Could not connect to db: $!\n";
$db->{RaiseError} = 1;

### List relevant scores
%seen = (%pp,%mm,%tt,%backlinks);

if (scalar(keys(%seen)) > 0) {
  $db->do("CREATE TEMPORARY TABLE theseitems (item varchar(20000));") or die $db->errstr;
  $sth = $db->prepare_cached("INSERT INTO theseitems (item) VALUES (?)");
  $sth2 = $db->prepare_cached("INSERT IGNORE INTO karma (item,score) VALUES (?,0)");
  foreach (keys(%seen)) {
    $sth->execute($_) or die $db->errstr;
    $sth2->execute($_) or die $db->errstr;
  }
  $sth->finish;
  $sth2->finish;
}

### Build list of stuff to display, while altering the table.
$ppsth = $db->prepare_cached("UPDATE karma SET score=score+1 WHERE item=?");
$mmsth = $db->prepare_cached("UPDATE karma SET score=score-1 WHERE item=?");
foreach $p (keys %pp) { 
  $ppsth->execute($p) or die $db->errstr;
}
foreach $m (keys %mm) {
  $mmsth->execute($m) or die $db->errstr;
}
$ppsth->finish;
$mmsth->finish;

### Add and remove links. Remember that linksdb is unique, so we can
### just try everything they requested.

if (keys(%linkdb)) {
  $sth = $db->prepare_cached("REPLACE INTO karmalinks (GetsKarma, GetsKarmaFrom, IsNegative) VALUES (?,?,?);");
  foreach $i (keys %linkdb) {
    foreach $j (keys %{$linkdb{$i}}) {
      $sth->execute($i,$j,$linkdb{$i}{$j}==-1) or die $db->errstr;
    }
  }
  $sth->finish;
}
if (keys(%unlinkme)) {
  $sth = $db->prepare_cached("DELETE FROM karmalinks WHERE GetsKarma=? AND GetsKarmaFrom=?");
  foreach $i (keys %unlinkme) {
    foreach $j ( keys %{$unlinkme{$i}} ) {
      $sth->execute($i,$j) or die $db->errstr;
    }
  }
  $sth->finish;
}

### Build the table to display, based on links.
if (scalar(keys(%seen))) {
  $sth = $db->prepare("SELECT karma.item,karma.score FROM karma JOIN theseitems ON karma.item=theseitems.item");
  $sth->execute or die $db->errstr;
  while ( ($i, $s) = $sth->fetchrow_array ) {
    $seen{$i} = $s;
  }
  $sth->finish;
  $scores = "";
  foreach $k (sort {lc($a) cmp lc($b)} (keys %seen)) {
    $k = lc($k);
    $k =~ s/\\/\\\\/g;
    $k =~ s/\"/\\\"/g;
    $thisscore = $seen{$k};
    if ($k eq "erik") {
      $reasons = "  erik: immortally.awesome\n";
    }
    else {
      $reasons = "  $k: ".$seen{$k}."\n";
    }
    $sth = $db->prepare("SELECT karma.item,karma.score,karmalinks.IsNegative FROM karma JOIN karmalinks ON karma.item=karmalinks.GetsKarmaFrom WHERE karmalinks.GetsKarma=\"$k\"");
    $sth->execute or die $db->errstr;
    while ( ($i, $s, $n) = $sth->fetchrow_array ) {
      if ($i eq "erik") {
        $reasons .= "  erik: immortally.awesome\n";
      }
      else {
        $reasons .= "  $i: ";
        if ($n) {
          $reasons .= "-($s)\n";
        }
        else {
          $reasons .= "$s\n";
        }
      }
      if ($n) {
        $thisscore -= $s;
      }
      else {
        $thisscore += $s;
      }
    }
    $sth->finish;
    if ($k eq "erik") { $scores .= "erik: immortally.awesome\n$reasons\n"; }
    else { $scores .= "$k: ".$thisscore."\n$reasons\n"; }
  }
  foreach $k (sort {lc($a) cmp lc($b)} (keys %backlinks)) {
    $k = lc($k);
    $k =~ s/\\/\\\\/g;
    $k =~ s/\"/\\\"/g;
    $thisscore = $seen{$k};
    $scores .= "\nThese entries are linked to $k:\n  ";
    $sth = $db->prepare("SELECT karma.item,karma.score,karmalinks.IsNegative FROM karma JOIN karmalinks ON karma.item=karmalinks.GetsKarma WHERE karmalinks.GetsKarmaFrom=\"$k\"");
    $sth->execute or die $db->errstr;
    @folks = ();
    while ( ($i, $s, $n) = $sth->fetchrow_array ) {
      if ($i eq "erik") {
        push(@folks,"erik (immortally.awesome)");
      }
      else {
        push(@folks,($n? "-($i) ($s)" : "$i ($s)"));
      }
    }
    $scores .= join("\n  ",@folks)."\n";
  }
}

foreach $d (@getdefs) {
  my @headers = (
   'User-Agent' => 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us)',
   'Accept-Charset' => 'iso-8859-1,*,utf-8',
   'Accept-Language' => 'en-US',
  );
  %sigh = (q => "define:".$d,
           biw => 78,
           hl => "en",
           btnG => "Google Search",
  );
  $args = enurl(\%sigh);
  $googleget = LWP::UserAgent -> new(cookie_jar => $mycookie);
  $gp = $googleget -> get("http://www.google.com/",@headers);
  $url = "http://www.google.com/search?$args";
  $gp = $googleget -> get($url,@headers) -> content or $email .= "$d: No content.\n";
  @defs = split(/<li>/,$gp); shift @defs;
  map {s/\n/ /gs; $_ = decode_entities($_); } @defs;
  $email .= "\n\n---------------------------------\n";
  $email .= "> Google definitions for $d:";
  if (scalar @defs == 0) {
    if ($gp =~ /No definitions were found for/) {
      $email .= "\n...no definitions were found for $d. Sorry!\n";
    }
    else {
      $email .= "\nPARSER ERROR: Could not extract definitions!\nPage returned is:\n$gp\n";
    }
  }
  foreach (@defs) {
    ($def,$url) = split(/<br><a href=\"/i);
    $url = "http://www.google.com".(split(/\"/,$url))[0];
    $email .= "\n\n* $def\n$url";
  }
  $email .= "\n";
  $display = 1;
}

### Construct the email to send.
$subject = "Parser response for $respond_to";

if (defined $newlinks) {
  $email .= "---------------------------------\n";
  $email .= "The following links have been CREATED. That means that the thing on the
left now has the karma from the thing on the right added to its score, or in
the case of a negative link, subtracted from its score. You may remove links
via use of the parser . unlink function:

$newlinks
";
  $display = 1;
}

if (defined $unlinks) {
  $email .= "---------------------------------\n";
  $email .= "The following links have been REMOVED. Thhat means that the thing on the
left no longer has the kamra from the thing on the right added to its score.
You may reinstate links via use of the parser . link function:

$unlinks
";
  $display = 1;
}

if ($scores ne "") {
  if (defined $newlinks || defined $unlinks) {
    $email .= "---------------------------------\n";
    $email .= "Affected table scores, after parsing your email:\n\n$scores\n";
  }
  else {
    $email .= "---------------------------------\n";
    $email .= "$scores";
  }
  $display = 1;
}

### Send the email if it has content.
if ($email) {
  $email = "Response for $respond_to\nFrom a message sent on $date and received by the parser\n$email\n$sig";
  
  if ($postfrom eq $ydpb) {
    $ysubj = "Parser Response from Yahoogroups";
    mySendmail($ydpb,$ysubj,$email);
  }
  elsif ($postfrom eq $gdpb) {
    $gsubj = "Parser Response from Googlegroups";
    mySendmail($gdpb,$gsubj,$email);
  }
}

### Run the query if it was requested.
if (defined $query) {
  $email = "Executed the query /$query/. Results ordered from lowest to highest:\n\n";
  $sth = $db->prepare("SELECT item,score FROM karma WHERE item REGEXP '$query' ORDER BY score");
  $sth->execute or die $db->errstr;
  while ( ($i, $s) = $sth->fetchrow_array ) {
    $thisscore = $s;
    $reasons = "";
    $i2 = $i;
    $i2 =~ s/\\/\\\\/g;
    $i2 =~ s/\"/\\\"/g;
#    print STDERR "item is $i, became $i2\n";
    $sth2 = $db->prepare("SELECT karma.item,karma.score FROM karma JOIN karmalinks ON karma.item=karmalinks.GetsKarmaFrom WHERE karmalinks.GetsKarma = \"$i2\"");
    $sth2->execute or die $db->errstr;
    while ( ($il, $sl) = $sth2->fetchrow_array ) {
      if ($il eq "erik") { $reasons .= "  erik: immortally.awesome\n"; }
      else { $reasons .= "  $il: $sl\n"; }
      $thisscore += $sl;
    }
    $sth2->finish;
    $email .= "$i: $thisscore\n$reasons\n";
  }
  $sth->finish;
  $email .= "\n$sig";
  $sub = $query =~ /all/ ? "All-item q" : "Q";
  $sub .= "uery response for $respond_to";
  mySendmail($postfrom,$sub,$email);
}

### Run the eightball if it was requested.
if (scalar @eightball > 0) {
  open(EB,"/home/parser/8ball.responses");
  while (<EB>) {
    chomp;
    push(@ebresponse,$_) unless $_ eq "";
  }
  close EB;

  $message = "The following questions were asked, and lo, I have answered:\n";
  foreach $query (@eightball) {
    $message .= "\n\"$query\"\n  ";
    $r = int ( rand (scalar @ebresponse) );
    $message .= $ebresponse[$r]."\n";
  }
#  $message .= "\n\nRemember: you can ssh into parser.ilovebacon.org with username and password
#of \"bullcrap\" to add to the 8 ball's vocabulary!\n";
  $message .= $sig;
  mySendmail($postfrom,"Eightball divination for $respond_to",$message);
}

### Display the link table if it was requested.
if ($showlinks) {
  $message = "The following links, matching $showlinks, and individual values have been recorded:\n\n";
  $sth = $db->prepare("SELECT * FROM karmalinks ORDER BY GetsKarma");
  $sth->execute or die $db->errstr;
  while ( ($gk,$gkf) = $sth->fetchrow_array ) {
    $message .= uc($gk) . " gets karma from ".uc($gkf)."\n";
  }
  $sth->finish;
  $message .= "\n$sig";
  mySendmail($postfrom,"Link list provided for $respond_to",$message);
}

$db->disconnect;
  
exit 0;
  
### Function to send emails.
sub mySendmail {
  my ($to, $subject, $text) = @_;
  my %mail = ( To => $to,
               From => 'The Parser <parser@ilovebacon.org>',
               Subject => $subject,
               Message => $text
             );
  sendmail(%mail) or die $Mail::Sendmail::error;

}