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 expires2timet
  16                       $dbh);
  17     %EXPORT_TAGS = ( );
  18     @EXPORT_OK   = qw();
  19 }
  20
  21 our ($dbh);
  22
  23 sub db_connect () {
  24     my $dbf;
  25     foreach my $d (@INC) {
  26         $dbf = "$d/away.db";
  27         if (stat $dbf) {
  28             chdir($d) or die $!;
  29             last;
  30         }
  31     }
  32     $dbh = DBI->connect("dbi:SQLite:away.db",
  33                          { AutoCommit=>0,
  34                            RaiseError=>1, ShowErrorStatement=>1
  35                          })
  36         or die "$DBI::errstr ?";
  37 }
  38
  39 sub nooutput ($) {
  40     my ($stmt) = @_;
  41     my $sth= $dbh->prepare($stmt);
  42     $sth->execute();
  43     my $row;
  44     if ($row= $sth->fetchrow_hashref()) {
  45         die("REFERENTIAL INTEGRITY ERROR\n".
  46             "\n$stmt\n". Dumper($row),"\n");
  47     }
  48 }
  49
  50 sub expires2timet ($) {
  51     my ($str) = @_;
  52     if ($str eq '') {
  53         return undef;
  54     }
  55     open F, "-|", qw(date -d),'$str',qw(+%s) or die $!;
  56     my $dtime = <F>;
  57     $?=0; $!=0; close F or die "$? $!";
  58     $dtime =~ m/^\d+$/ or die "$dtime ?";
  59     return $dtime+0;
  60 }
  61
  62 sub db_commit () {
  63     nooutput("SELECT * FROM addresses LEFT JOIN config".
  64              " USING (emailaddr) WHERE forwardfile IS NULL");
  65     nooutput("SELECT * FROM addresses LEFT JOIN texts".
  66              " USING (textid) WHERE name IS NULL");
  67     $dbh->do("COMMIT");
  68 }
  69
  70 1;