Putting PostgreSQL Through its Paces

  1	#!/usr/bin/perl -w
  2	use strict;
  3	$|++;
  4
  5	use DBI;
  6
  7	## configuration
  8	my $REMOTE = “http://foldoc.doc.ic.ac.uk/foldoc/Dictionary“;
  9	my $LOCAL = “/home/merlyn/Web/Dictionary.txt”;
  10	my @DSN = qw(dbi:Pg:dbname= foldoc_word_of_the_day USER PASS);
  11	## end configuration
  12
  13	my $dbh = DBI->connect(@DSN, {RaiseError => 1, PrintError => 0});
  14
  15	refresh_wordlist() if -w $LOCAL;
  16	my ($word, $meaning) = get_word_and_meaning_for(scalar getpwuid $<);
  17
  18	if ($ENV{GATEWAY_INTERFACE}) {  # running under CGI
  19	   require HTML::FromText;
  20
  21	   print “Content-type: text/htmlnn”;
  22	   print HTML::FromText::text2html(”$wordnn$meaning”,
  23	       map { $_ => 1 }
  24	       qw(title urls email paras));
  25	} else {
  26	   print “$wordn$meaning”;
  27	}
  28
  29	$dbh->disconnect;
  30
  31	exit 0;
  32
  33	sub refresh_wordlist {
  34	   require LWP::Simple;
  35	   return unless LWP::Simple::mirror($REMOTE, $LOCAL) == 200;
  36
  37	   eval {
  38	      $dbh->do(q{CREATE TABLE foldoc (word text, meaning text)});
  39	   };
  40	   die $@ if $@ and $@ !~ /already exists/;
  41
  42	   eval {
  43	      $dbh->begin_work;
  44
  45	      $dbh->do(q{DELETE FROM foldoc}); # clean it out
  46
  47	      my $insert = $dbh->prepare
  48	         (q{INSERT INTO foldoc(word, meaning) VALUES (?, ?)});
  49
  50	      open LOCAL, $LOCAL or die;
  51	      my $entry;
  52	      {
  53	         $_ = <LOCAL>;
  54	         if (not defined $_ or /^S/) { # end of definition
  55	            if (defined $entry) {   # save any cached definition
  56	               $entry =~ s/^(S.*)n([ t]*n) *// or die;
  57	               my $key = $1;      # get key
  58	               $entry =~ s/s+z/n/; # clean up definition
  59
  60	               unless ($key =~ /Free On-line Dictionary|Acknowledgements/) {
  61	                  print “$key -> “;
  62	                  print $insert-> execute($key, $entry);
  63	                  print “n”;
  64	               }
  65
  66	               undef $entry;
  67	            }
  68	            last unless defined $_;
  69	         }
  70	         $entry .= $_;
  71	         redo;
  72	      }
  73	      $dbh->commit;
  74	   };
  75	   if ($@) {
  76	      $dbh->rollback;
  77	      die $@;
  78	   }
  79
  80	   ## create and reset word
  81
  82	   eval {
  83	      $dbh->do(q{CREATE TABLE deck (word text, person text)});
  84	   };
  85	   die $@ if $@ and $@ !~ /already exists/;
  86
  87	   eval {
  88	      $dbh->begin_work;
  89	      $dbh->do(q{DELETE FROM deck}); # clean it out
  90	      $dbh->commit;
  91	   };
  92	   if ($@) {
  93	      $dbh->rollback;
  94	      die $@;
  95	    }
  96
  97	}
  98
  99	sub get_word_and_meaning_for {
  100	   my $person = shift;
  101
  102	   for (my $tries = 0; $tries <= 2; $tries++) {
  103	      $dbh->begin_work;
  104	      if (my ($word) =
  105	          $dbh->selectrow_array(q{
  106	                             SELECT word FROM deck
  107	                             WHERE person = ?
  108	                             FOR UPDATE OF deck
  109	                             LIMIT 1
  110	                            },
  111	                           undef, $person)) {
  112
  113	         ## got a good word
  114	         $dbh->do(q{DELETE FROM deck WHERE (word, person) = (?, ?)},
  115	                 undef, $word, $person);
  116	         $dbh->commit;
  117
  118	         if (my ($meaning) =
  119	             $dbh->selectrow_array(q{
  120	                                SELECT meaning FROM foldoc 
  121	                                WHERE word = ?
  122	                               }, undef, $word)) {
  123	             return ($word, $meaning);
  124	         }
  125
  126	         die “missing meaning for $wordn”;
  127	      } else {
  128	         ## no words left, shuffle the deck
  129
  130	         $dbh->do(q{
  131	                  INSERT INTO deck (word, person)
  132	                  SELECT word, ?
  133	                  FROM foldoc
  134	                  ORDER BY random()
  135	                 }, undef, $person);
  136	         $dbh->commit;
  137	      }
  138	   }
  139	   die “Cannot get a word for $personn”;
  140	}