AwayMsg.pm

   1
   2 package AwayMsg;
   3
   4 use strict;
   5 use warnings;
   6
   7 use DBI;
   8
   9 BEGIN {
  10     use Exporter ();
  11     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  12     $VERSION     = 1.00;
  13     @ISA         = qw(Exporter);
  14     @EXPORT      = qw(&db_connect &db_commit $dbh);
  15     %EXPORT_TAGS = ( );
  16     @EXPORT_OK   = qw();
  17 }
  18
  19 our ($dbh);
  20
  21 sub db_connect () {
  22     my $dbf;
  23     foreach my $d (@INC) {
  24         $dbf = "$d/away.db";
  25         if (stat $dbf) {
  26             chdir($d) or die $!;
  27             last;
  28         }
  29     }
  30     $dbh = DBI->connect("dbi:SQLite:away.db",
  31                          { AutoCommit=>0,
  32                            RaiseError=>1, ShowErrorStatement=>1
  33                          })
  34         or die "$DBI::errstr ?";
  35 }
  36
  37 sub nooutput ($) {
  38     my ($stmt) = @_;
  39     my $sth= $dbh->prepare($stmt);
  40     $sth->execute();
  41     my $row;
  42     if ($row= $sth->fetchrow_hashref()) {
  43         die("REFERENTIAL INTEGRITY ERROR\n".
  44             "\n$stmt\n". Dumper($row),"\n");
  45     }
  46 }
  47
  48
  49 sub db_commit () {
  50     nooutput("SELECT * FROM addresses LEFT JOIN config USING (emailaddr)");
  51     nooutput("SELECT * FROM addresses LEFT JOIN texts USING (textid)");
  52     $dbh->do("COMMIT");
  53 }
  54
  55 1;