X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=nj-awaymsg.git;a=blobdiff_plain;f=AwayMsg.pm;h=e20d6b6acc39f5b825a8fce78657bc45c79c4494;hp=468e9f072b15005c7658dc1009bea3d126a2dea9;hb=42a6560ca0aa3325296f3ea72096232cdc056cb5;hpb=fa1084e8d681187707259ed712f6d5d5c7b99526 diff --git a/AwayMsg.pm b/AwayMsg.pm index 468e9f0..e20d6b6 100644 --- a/AwayMsg.pm +++ b/AwayMsg.pm @@ -1,48 +1,55 @@ -module AwayMsg; package AwayMsg; + use strict; use warnings; +use DBI; + BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); - @EXPORT = qw(&db_connect $dhb); + @EXPORT = qw(&db_connect &db_commit $dbh); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); } +our ($dbh); + sub db_connect () { - my $h = DBI->connect("dbi:SQLite:away.db", + my $dbf; + foreach my $d (@INC) { + $dbf = "$d/away.db"; + if (stat $dbf) { + chdir($d) or die $!; + last; + } + } + $dbh = DBI->connect("dbi:SQLite:away.db", { AutoCommit=>0, RaiseError=>1, ShowErrorStatement=>1 }) - or die "$DBI:errstr ?"; - - $dbh->do("BEGIN"); - - $dbh->do("CREATE TEMPORARY TABLE config (". - " emailaddr TEXT PRIMARY KEY NOT NULL,". - " username TEXT NOT NULL,". - " forwardfile TEXT NOT NULL". - ")"); - - open C, "config" or die $!; - while () { - s/^\s+//; - next if m/^\#/; - chomp or die; - s/\s+$//; - my @s = split; - die "$_ ?" unless @s==3; - $dbh->do("INSERT INTO config". - " (emailaddr, username, forwardfile)". - " VALUES (?,?,?)", - {}, @s); + or die "$DBI::errstr ?"; +} + +sub nooutput ($) { + my ($stmt) = @_; + my $sth= $dbh->prepare($stmt); + $sth->execute(); + my $row; + if ($row= $sth->fetchrow_hashref()) { + die("REFERENTIAL INTEGRITY ERROR\n". + "\n$stmt\n". Dumper($row),"\n"); } - $dbh->do("COMMIT"); +} + - return $h; +sub db_commit () { + nooutput("SELECT * FROM addresses LEFT JOIN config USING (emailaddr)"); + nooutput("SELECT * FROM addresses LEFT JOIN texts USING (textid)"); + $dbh->do("COMMIT"); } + +1;