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