rename
[PerlMail.git] / perlmail-submit
index 43d3fdc..8a452ad 100755 (executable)
@@ -15,15 +15,12 @@ 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=600;        # 15sec is NOT enough!
-my $DB_table="LaceMail_folder";
+
+my $Lock_pathname="/tmp/PerlMail.lock";
+#my $PeerAddr="dejhome.dyn.jankratochvil.net.:852";
+my $PeerAddr="127.0.0.1:2852";
+my $Socket_timeout=7600;       # 15sec is NOT enough!
+my $DB_table="PerlMail_folder";
 my $DBI_database="short";
 my $DBI_user="short";
 my $DBI_pwd=$ENV{"HOME"}."/priv/mysql.".$DBI_user.".pwd";
@@ -69,6 +66,7 @@ sub store
                local $/;
                $message=<STDIN>;
                }
+       close STDIN or cluck "close STDIN: $!";
        my %row=(
                        "message"=>$message,
                        # assume "retries"=>0,
@@ -77,7 +75,14 @@ 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
+}
+
+sub forkoff
+{
+       my $pid=fork();
+       confess if !defined $pid;
+       exit 0 if $pid; # parent
+       # child
 }
 
 my $submitonce_run=0;
@@ -177,7 +182,7 @@ my($keyword,$interval)=@_;
        $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 time<from_unixtime(unix_timestamp()-$sec)");
+                       ." from $DB_table where retries is null and time<from_unixtime(unix_timestamp()-$sec)");
        $sth->execute();
        if (!$print) {
                print $sth->rows()."\n";
@@ -194,9 +199,10 @@ $Getopt::Long::ignorecase=0;
 die if !GetOptions(
                  "initdb" ,\&initdb,
                  "store"  ,\&store,
+                 "forkoff",\&forkoff,
                  "submit" ,\&submit,
                  "pending",\&pending,
                  "clean:s",\&clean,
-               "V|version",sub { print "lacemail-submit: $VERSION\n"; exit 0; },
+               "V|version",sub { print "perlmail-submit: $VERSION\n"; exit 0; },
                );
 exit 0;