pregen: wip

diff --git a/evade-mail-pregen b/evade-mail-pregen
index d98337b8aec5beb4046edeadd1e6e86ea9ffcc59..a3754375ba105b019309117db186015661ad2f53 100755 (executable)
--- a/evade-mail-pregen
+++ b/evade-mail-pregen
@@ -1,12 +1,14 @@
 #!/usr/bin/perl -w
 use strict;
+use Carp;
 our $us = $0; $us =~ s#.*/##;
 our $usage = <<'END';
 usage:
  $us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
  $us [<opts>] assign <number>|<localpart>@[domain] <comment>
- $us [<opts>] show <count>              } will generate more aliases
- $us [<opts>] range [<from>-[<to>]]     }  if necessary
+ $us [<opts>] list
+ $us [<opts>] some <count>                     } will generate aliases
+ $us [<opts>] range <min>-<max>|<min>+<count>  }  as necessary
 opts:
  -G<generator>           generator/lister program
  -N                      do not generate more aliases
@@ -19,12 +21,17 @@ notes:
   whole comment to protect it from your shell
 END
 
+sub fail { die "$us: @_\n"; }
+sub badusage { fail "bad usage: @_"; }
+sub failstdout () { fail "stdout: $!"; }
+
 our $generator;
 our $no_generate=0;
 our @genopts;
 
 our %by_localpart;
 our @by_number;
+our $min_number;
 
 our $comment_pattern = '### PREGEN <number>';
 our $comment_re;
@@ -32,14 +39,15 @@ our $comment_re;
 sub comment_make ($) {
     my ($num) = @_;
     my $r = $comment_pattern;
-    ($r =~ s/\<number\>/$num/) == 1 or die "$r ?";
+    ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
     return $r;
 }
 
-sub fetch_list {
-    open P, "-!", $generator, qw(list) or die $!;
+sub run_generator {
+    my @genargs = @_;
+    open P, "-!", $generator, @genargs or fail "fork $generator: $!";
     while (<P>) {
-       my ($alias,$user);
+       my ($alias,$comment);
        if (m/^\# user/) {
            next;
        } elsif (m/^\# reject (\S+) (\#.*)$/) {
@@ -58,20 +66,28 @@ sub fetch_list {
            $row->{Number}= $1;
        }
        $by_localpart{$row->{LocalPart}} = $row;
-       $by_number[$row->{Number}] = $row if defined $row->{Number};
+       if (defined $row->{Number}) {
+           $by_number[$row->{Number}] = $row;
+           $min_number = $row->{Number} if
+               (!defined $min_number) || $min_number > $row->{Number};
     }
-    $?=0; $!=0; close P or die "$generator $! $?";
+    $?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n";
+}
+
+sub fetch_list () {
+    run_generator qw(list);
 }
 
-sub generate ($) {
+sub perhaps_generate ($) {
     my ($num) = @_;
     return undef if $no_generate;
     my $alias = $by_number[$num];
     return $alias if $alias;
-    run_generator qw(create) 
-    $!=0; $?=0; (system $generator, qw(create), comment_make $num)
-       ==0 or die "$generator failed ($! $?)";
-    
+    return undef unless $num > $#by_number;
+    run_generator qw(create), (comment_make $num);
+    $alias = $by_number[$num];
+    confess "$num ?" unless $alias;
+    return $alias;
 }
 
 sub parse_target {
@@ -80,11 +96,11 @@ sub parse_target {
     my $target;
     if ($spec =~ m/^(\d{1,9})$/) {
        $target = $by_number[$spec];
-       die "no alias number $target\n" unless $target;
+       fail "no alias number $target" unless $target;
     } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
        $target = $by_localpart{$1};
-       die "no alias with local part \`$1'\n" unless $target;
-       die "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'\n"
+       fail "no alias with local part \`$1'" unless $target;
+       fail "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'"
            unless $spec eq $target->{Alias} ||
                   $spec eq $target->{LocalPart}.'@';
     } else {
@@ -92,19 +108,26 @@ sub parse_target {
     }
 }
 
+sub report ($) {
+    my ($alias) = @_;
+    confess unless $alias;
+    print $alias->{Number}, ' ', $alias->{LocalPart}, "\n"
+       or failstdout;
+}
+
 sub action_update {
     my $target = parse_target;
     @ARGV or badusage "missing update info\n";
     if (defined $target->{Number} && $target->{Number} == $#by_number) {
-       my $wanted = $target->{Number}+1;
-       generate $wanted
-           or print STDERR <<END
+       my $wanted = $#by_number + 1;
+       perhaps_generate $wanted
+           or print STDERR <<END or fail "stderr: $!"
 $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;
-    die "$generator: $!";
+    fail "exec $generator: $!";
 }
 
 sub action_assign {
@@ -114,6 +137,49 @@ sub action_assign {
     action_update;
 }
 
+sub action_list {
+    @ARGV==0 or
+       badusage "invalid arguments to list";
+    my $num = $min_number;
+    while ($num <= $#by_number) {
+       my $alias = $by_number[$num];
+       report $alias if $alias;
+    }
+}
+
+sub action_some {
+    (@ARGV==1 &&
+     $ARGV[0] =~ m/^(\d+)$/s) or
+     badusage "invalid arguments to some";
+    my ($count) = $1;
+    my $num = $min_number;
+    while ($count > 0) {
+       my $alias = generate $num;
+       if ($alias) {
+           report $alias;
+           $count--;
+       } else {
+           last if $num > $#by_number; # -N
+           $num++;
+       }
+    }
+}
+
+sub action_range {
+    (@ARGV==1 &&
+     $ARGV[0] =~ m/^(\d+)(?:([-+])(\d+))?$/s) or
+     badusage "invalid arguments to range";
+    my ($num,$op,$rarg) = ($1,$2,$3);
+    my $limit =
+       $op eq '+' ? $num+$rarg-1 :
+       $op eq '-' ? $rarg :
+       confess "$op ??";
+    for (; $num<=$limit; $num++) {
+       my $alias = generate $num;
+       report $alias if $alias;
+    }
+}    
+
 for (;;) {
     last unless @ARGV;
     last unless $ARGV[0] =~ m/^-/;
@@ -132,8 +198,12 @@ for (;;) {
     }
 }
 
-our $child = $us;
-$child =~ s/-pregen/; fixme fixme this should be defaulting generator
+if (!defined $generator) {
+    $generator = $us;
+    $generator =~ s/-pregen$//
+       or fail "unable to calculate default generator".
+           " (want to strip \`-pregen' from our program name, \`$us')";
+}
 
 $comment_pattern =~ m/^#/s
     or badusage "comment pattern must start with \`#'";
@@ -144,5 +214,12 @@ $comment_re =~ s/\W/\\$&/g;
 
 @ARGV or badusage "missing action\n";
 my $action = shift @ARGV;
+
+fetch_list();
+
 $action =~ y/-/_/;
-{ no strict qw(refs); &{"action_$action"}; }
+my $actionsub = { no strict qw(refs); \&{"action_$action"}; }
+defined $actionsub or badusage "unknown action $action";
+$actionsub->();
+
+close STDOUT or failstdout;