AwayMsg.pm

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