pregen: wip

[d.git] / evade-mail-pregen

diff --git a/evade-mail-pregen b/evade-mail-pregen
index a3754375ba105b019309117db186015661ad2f53..e15ae83d8edcf7b3e777d8ac9776f7b245c79b84 100755 (executable)
--- a/evade-mail-pregen
+++ b/evade-mail-pregen
@@ -45,7 +45,7 @@ sub comment_make ($) {
 
 sub run_generator {
     my @genargs = @_;
-    open P, "-!", $generator, @genargs or fail "fork $generator: $!";
+    open P, "-|", $generator, @genargs or fail "fork $generator: $!";
     while (<P>) {
        my ($alias,$comment);
        if (m/^\# user/) {
@@ -70,6 +70,7 @@ sub run_generator {
            $by_number[$row->{Number}] = $row;
            $min_number = $row->{Number} if
                (!defined $min_number) || $min_number > $row->{Number};
+       }
     }
     $?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n";
 }
@@ -80,9 +81,9 @@ sub fetch_list () {
 
 sub perhaps_generate ($) {
     my ($num) = @_;
-    return undef if $no_generate;
     my $alias = $by_number[$num];
     return $alias if $alias;
+    return undef if $no_generate;
     return undef unless $num > $#by_number;
     run_generator qw(create), (comment_make $num);
     $alias = $by_number[$num];
@@ -126,8 +127,8 @@ $us: Losing track of next number ($wanted), due to use of -N;
 $us: will start next alias at #0, unless you say (e.g.) "range $wanted".
 END
     }
-    exec $generator, qw(update), $target->{Alias}, @ARGV;
-    fail "exec $generator: $!";
+    exec $generator, qw(update), $target->{Alias}, @ARGV
+       or fail "exec $generator: $!";
 }
 
 sub action_assign {
@@ -141,6 +142,7 @@ sub action_list {
     @ARGV==0 or
        badusage "invalid arguments to list";
     my $num = $min_number;
+    $num ||= 0;
     while ($num <= $#by_number) {
        my $alias = $by_number[$num];
        report $alias if $alias;
@@ -153,13 +155,19 @@ sub action_some {
      badusage "invalid arguments to some";
     my ($count) = $1;
     my $num = $min_number;
+    $num ||= 0;
     while ($count > 0) {
-       my $alias = generate $num;
+       my $alias = perhaps_generate $num;
        if ($alias) {
            report $alias;
            $count--;
        } else {
-           last if $num > $#by_number; # -N
+           if ($num > $#by_number) {
+               print STDERR <<END or fail "stderr: $!";
+$us: fewer than requested aliases printed, due to -N
+END
+               last;
+           }
            $num++;
        }
     }
@@ -175,7 +183,7 @@ sub action_range {
        $op eq '-' ? $rarg :
        confess "$op ??";
     for (; $num<=$limit; $num++) {
-       my $alias = generate $num;
+       my $alias = perhaps_generate $num;
        report $alias if $alias;
     }
 }    
@@ -185,12 +193,12 @@ for (;;) {
     last unless $ARGV[0] =~ m/^-/;
     my $arg = shift @ARGV;
     last if $arg =~ m/^--?$/;
-    while ($arg !~ m/^-$/) {
+    while ($arg =~ m/^-./) {
        if ($arg =~ s/^-[ldFm]/-/) {
            push @genopts, $arg;
-       } elsif ($arg =~ s/^-G//) {
-           $generator = $'; #';
-       } elsif ($arg =~ s/^-N//) {
+       } elsif ($arg =~ s/^-G(.*)//) {
+           $generator = $1;
+       } elsif ($arg =~ s/^-N/-/) {
            $no_generate = 1;
        } else {
            badusage "unknown option \`$arg'";
@@ -209,16 +217,18 @@ $comment_pattern =~ m/^#/s
     or badusage "comment pattern must start with \`#'";
 $comment_re = $comment_pattern;
 $comment_re =~ s/\W/\\$&/g;
-($comment_re =~ s'\<number\>'([1-9]\d{0,8})'g) == 1 #'
-    or badusage "comment pattern must contain \`<number>' exactly once";
+($comment_re =~ s'\\<number\\>'([1-9]\d{0,8})'g) == 1 #'
+    or badusage "comment pattern (\`$comment_pattern')".
+         " must contain \`<number>' exactly once";
 
-@ARGV or badusage "missing action\n";
+@ARGV or badusage "missing action";
 my $action = shift @ARGV;
 
 fetch_list();
 
 $action =~ y/-/_/;
-my $actionsub = { no strict qw(refs); \&{"action_$action"}; }
+my $actionsub;
+{ no strict qw(refs); $actionsub = \&{"action_$action"}; }
 defined $actionsub or badusage "unknown action $action";
 $actionsub->();