chiark / gitweb /
run-mason.cgi: seems to work
[nj-awaymsg.git] / 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;
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;