#!/usr/bin/perl -w
use strict;
$|++;

use DBI;

## configuration
my $REMOTE = "http://foldoc.doc.ic.ac.uk/foldoc/Dictionary";
my $LOCAL = "/home/merlyn/Web/Dictionary.txt";
my @DSN = qw(dbi:Pg:dbname=foldoc_word_of_the_day USER PASS);
## end configuration

my $dbh = DBI->connect(@DSN, {RaiseError => 1, PrintError => 0});

refresh_wordlist() if -w $LOCAL;
my ($word, $meaning) = get_word_and_meaning_for(scalar getpwuid $<);

if ($ENV{GATEWAY_INTERFACE}) {  # running under CGI
  require HTML::FromText;

  print "Content-type: text/html\n\n";
  print HTML::FromText::text2html("$word\n\n$meaning",
                                  map { $_ => 1 }
                                  qw(title urls email paras));
} else {
  print "$word\n$meaning";
}

$dbh->disconnect;

exit 0;

sub refresh_wordlist {
  require LWP::Simple;
  return unless LWP::Simple::mirror($REMOTE, $LOCAL) == 200;

  eval {
    $dbh->do(q{CREATE TABLE foldoc (word text, meaning text)});
  };
  die $@ if $@ and $@ !~ /already exists/;

  eval {
    $dbh->begin_work;

    $dbh->do(q{DELETE FROM foldoc}); # clean it out

    my $insert = $dbh->prepare
      (q{INSERT INTO foldoc(word, meaning) VALUES (?, ?)});

    open LOCAL, $LOCAL or die;
    my $entry;
    {
      $_ = <LOCAL>;
      if (not defined $_ or /^\S/) { # end of definition
        if (defined $entry) {   # save any cached definition
          $entry =~ s/^(\S.*)\n([ \t]*\n)*// or die;
          my $key = $1;         # get key
          $entry =~ s/\s+\z/\n/; # clean up definition

          unless ($key =~ /Free On-line Dictionary|Acknowledgements/) {
            print "$key -> ";
            print $insert->execute($key, $entry);
            print "\n";
          }

          undef $entry;
        }
        last unless defined $_;
      }
      $entry .= $_;
      redo;
    }
    $dbh->commit;
  };
  if ($@) {
    $dbh->rollback;
    die $@;
  }

  ## create and reset word

  eval {
    $dbh->do(q{CREATE TABLE deck (word text, person text)});
  };
  die $@ if $@ and $@ !~ /already exists/;

  eval {
    $dbh->begin_work;
    $dbh->do(q{DELETE FROM deck}); # clean it out
    $dbh->commit;
  };
  if ($@) {
    $dbh->rollback;
    die $@;
  }

}

sub get_word_and_meaning_for {
  my $person = shift;

  for (my $tries = 0; $tries <= 2; $tries++) {
    $dbh->begin_work;
    if (my ($word) =
        $dbh->selectrow_array(q{
                                SELECT word FROM deck
                                WHERE person = ?
                                FOR UPDATE OF deck
                                LIMIT 1
                               },
                              undef, $person)) {

      ## got a good word
      $dbh->do(q{DELETE FROM deck WHERE (word, person) = (?, ?)},
               undef, $word, $person);
      $dbh->commit;

      if (my ($meaning) =
          $dbh->selectrow_array(q{
                                  SELECT meaning FROM foldoc
                                  WHERE word = ?
                                 }, undef, $word)) {
        return ($word, $meaning);
      }

      die "missing meaning for $word\n";
    } else {
      ## no words left, shuffle the deck

      $dbh->do(q{
                 INSERT INTO deck (word, person)
                 SELECT word, ?
                 FROM foldoc
                 ORDER BY random()
                }, undef, $person);
      $dbh->commit;
    }
  }
  die "Cannot get a word for $person\n";
}