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 hquote
  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 hquote ($) {
  29     my ($raw) = @_;
  30     return pack "H*", $raw;
  31 }
  32
  33 sub db_connect () {
  34     my $dbf = "$ENV{'NJAWAYMSG'}/data/away.db";
  35     $dbh = DBI->connect("dbi:SQLite:$dbf",'','',
  36                          { AutoCommit=>0,
  37                            RaiseError=>1, ShowErrorStatement=>1
  38                          })
  39         or die "$DBI::errstr ?";
  40 }
  41
  42 sub nooutput ($) {
  43     my ($stmt) = @_;
  44     my $sth= $dbh->prepare($stmt);
  45     $sth->execute();
  46     my $row;
  47     if ($row= $sth->fetchrow_hashref()) {
  48         die("REFERENTIAL INTEGRITY ERROR\n".
  49             "\n$stmt\n". Dumper($row),"\n");
  50     }
  51 }
  52
  53 sub db_commit () {
  54     nooutput("SELECT * FROM addresses LEFT JOIN config".
  55              " USING (emailaddr) WHERE forwardfile IS NULL");
  56     nooutput("SELECT * FROM addresses LEFT JOIN texts".
  57              " USING (textid) WHERE desc IS NULL");
  58     $dbh->do("COMMIT");
  59 }
  60
  61 1;