6 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
12 use Carp qw(cluck confess);
13 require IO::Socket::INET;
19 my $Lock_pathname="/tmp/LaceMail.lock";
20 my $PeerAddr="dejhome.dyn.jankratochvil.net.:852";
21 my $Socket_timeout=15;
22 my $DB_table="LaceMail_folder";
23 my $DBI_database="short";
25 my $DBI_pwd=$ENV{"HOME"}."/priv/mysql.".$DBI_user.".pwd";
26 open DBI_PWD,$DBI_pwd or die "open \"$DBI_pwd\": $!";
28 close DBI_PWD or warn "close DBI_pwd: $!";
31 my $DBI=DBI->connect_cached("DBI:mysql:database=$DBI_database;host=","$DBI_user",$DBI_pwd,{
32 "PrintError"=>0, # handled by "RaiseError" below
34 "ShowErrorStatement"=>1,
36 }) or confess "Failed DBI->connect(): $!";
43 eval { $DBI->do("drop table $name"); };
44 $DBI->do("create table $name (".join(",",@$cols).")");
49 create_table($DB_table,[
50 "id int not null auto_increment primary key",
51 "time timestamp not null", # assume ." default now()"
52 "message longtext not null",
53 "retries int null default 0", # null=>done, 0=not yet tried to submit
56 $DBI->do("alter table $DB_table add index (retries,id)");
70 # assume "retries"=>0,
72 my $prep=$DBI->prepare_cached("insert into $DB_table (".join(",",keys(%row)).")"
73 ." values (".join(",",map("?",keys(%row))).")");
74 $prep->execute(values(%row));
75 print $prep->{"mysql_insertid"}."\n";
83 open LOCK,">>$Lock_pathname" or die "open-append \"$Lock_pathname\": $!";
84 if (!flock LOCK,LOCK_EX|LOCK_NB) {
85 # NEVER unlink here, we are not the lock owning process!
89 my $sth=$DBI->prepare("select id,message from $DB_table where retries is not null"
90 # process only non-problematic mails during rerun
91 .($submitonce_run==1 ? "" : " and retries=0")
92 ." order by retries asc,id asc");
97 while (my $row=$sth->fetchrow_hashref()) {
98 $DBI->do("update $DB_table set retries=retries+1 where id=".$row->{"id"});
100 $sock=IO::Socket::INET->new(
101 "PeerAddr"=>$PeerAddr,
103 ) or confess "IO::Socket::INET->new(\"$PeerAddr\"): $!";
104 $sock->connected() or confess "socket not connected";
106 $sock->printflush(length($row->{"message"})."\n".$row->{"message"});
107 alarm $Socket_timeout and $sock->timeout($Socket_timeout) if $Socket_timeout;
109 my $gotlen=$sock->sysread($got,1);
110 confess $row->{"id"}.": sysread(1)=".(!defined $gotlen ? "undef" : $gotlen).": $!"
111 if !defined($gotlen) || $gotlen!=1;
114 # Prevent mailing errors from cron invoking us etc.
115 #print STDERR "FAIL:".$row->{"id"}."\n";
119 $DBI->do("update $DB_table set retries=null where id=".$row->{"id"});
121 print $progresschar.$row->{"id"}.($got eq "1" ? "" : "=FAIL");
125 $sock->shutdown(0); # stopped reading
126 $sock->printflush("BYE\n");
127 $sock->shutdown(2); # stopped using
130 print "\n" if $progresschar;
131 unlink $Lock_pathname;
133 return $progresschar;
138 1 while submitonce();
143 my $sth=$DBI->prepare("select message from $DB_table where state='pending' order by id");
145 while (my $row=$sth->fetchrow_hashref()) {
146 print $row->{"message"},"\n";
151 $Getopt::Long::ignorecase=0;
157 "V|version",sub { print "lacemail-submit: $VERSION\n"; exit 0; },