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