X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-submit;h=782bb4dcced3e0aeeb141fa123904426b6a40c7a;hp=2901153700e7d1fc56ca3791c8b9391be9573ed5;hb=595dde9002608bf18a84b22dafd5fe779c500421;hpb=b68782d3f8bca18eb93a2abf167541986decedfc

diff --git a/perlmail-submit b/perlmail-submit
index 2901153..782bb4d 100755
--- a/perlmail-submit
+++ b/perlmail-submit
@@ -15,10 +15,14 @@ use IO::Handle;
 use POSIX qw(mktime);
 use Fcntl qw(:flock);
 
+my $ExitCode;
+END {
+	exit $ExitCode if defined $ExitCode;
+	}
 
 my $Lock_pathname="/tmp/LaceMail.lock";
 my $PeerAddr="dejhome.dyn.jankratochvil.net.:852";
-my $Socket_timeout=15;
+my $Socket_timeout=600;	# 15sec is NOT enough!
 my $DB_table="LaceMail_folder";
 my $DBI_database="short";
 my $DBI_user="short";
@@ -73,6 +77,7 @@ sub store
 			." values (".join(",",map("?",keys(%row))).")");
 	$prep->execute(values(%row));
 	print $prep->{"mysql_insertid"}."\n";
+	$ExitCode=0;	# we will succeed even if --submit fails
 }
 
 my $submitonce_run=0;
@@ -140,13 +145,50 @@ sub submit
 
 sub pending
 {
-	my $sth=$DBI->prepare("select message from $DB_table where state='pending' order by id");
+	my $sth=$DBI->prepare("select message from $DB_table where retries is not null order by id");
 	$sth->execute();
 	while (my $row=$sth->fetchrow_hashref()) {
 		print $row->{"message"},"\n";
 		}
 }
 
+sub clean
+{
+my($keyword,$interval)=@_;
+
+	# FIXME: SQL "now()" is raced against the block above
+	my $sth=$DBI->prepare("select id,time,retries from $DB_table where time>now()");
+	$sth->execute();
+	while (my $row=$sth->fetchrow_hashref()) {
+		warn "Message time in future: ".join(",",map(
+				"$_=".(!defined $row->{$_} ? "NULL" : $row->{$_})
+				,keys(%$row)));
+		}
+
+	return if $interval eq "";
+	local $_=$interval;
+	my $print=s/^print://;
+	s/(\d+)y/($1*12)."m"/ge;
+	s/(\d+)m/($1*30)."d"/ge;
+	s/(\d+)d/($1*24)."h"/ge;
+	s/(\d+)h/($1*60)."M"/ge;
+	s/(\d+)M/($1*60)."s"/ge;
+	my $sec=0;
+	$sec+=$1 while s/(\d+)s//g;
+	die "Interval parse error; left \"$_\", parsed: $interval" if $_ ne "";
+	$sth=$DBI->prepare(($print ? "select id" : "delete")
+			." from $DB_table where retries is null and time<from_unixtime(unix_timestamp()-$sec)");
+	$sth->execute();
+	if (!$print) {
+		print $sth->rows()."\n";
+		}
+	else {
+		while (my $row=$sth->fetchrow_hashref()) {
+			print $row->{"id"},"\n";
+			}
+		}
+}
+
 
 $Getopt::Long::ignorecase=0;
 die if !GetOptions(
@@ -154,6 +196,7 @@ die if !GetOptions(
 		  "store"  ,\&store,
 		  "submit" ,\&submit,
 		  "pending",\&pending,
+		  "clean:s",\&clean,
 		"V|version",sub { print "lacemail-submit: $VERSION\n"; exit 0; },
 		);
 exit 0;