evade-mail-pregen: fix usage message

[d.git] / evade-mail-pregen

diff --git a/evade-mail-pregen b/evade-mail-pregen
index 9fcafc66fbbc2e93ac8857192cea01cde14782a7..be5c895ac0cf6452a7e9473f89611071eec0bc8b 100755 (executable)
--- a/evade-mail-pregen
+++ b/evade-mail-pregen
@@ -2,16 +2,17 @@
 use strict;
 use Carp;
 our $us = $0; $us =~ s#.*/##;
-our $usage = <<'END';
+our $usage = <<END;
 usage:
- $us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
- $us [<opts>] assign <number>|<localpart>@[domain] <comment>
+ $us [<opts>] update <number>|<localpart>\@[domain] [<reason>] [<comment>]
+ $us [<opts>] assign <number>|<localpart>\@[domain] <comment>
  $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
+ -q                      do not show domain, just local part
  -l.., -d.., -F.., -m..  passed to generator
 notes:
  Always use $us to edit the comment of a pregen alias;
@@ -27,6 +28,7 @@ sub failstdout () { fail "stdout: $!"; }
 
 our $generator;
 our $no_generate=0;
+our $show_domain=1;
 our @genopts;
 
 our %by_localpart;
@@ -36,6 +38,25 @@ our $min_number;
 our $comment_pattern = '### PREGEN <number>';
 our $comment_re;
 
+open DEBUG, ">/dev/null" or die $!;
+
+sub debug {
+    print DEBUG "$us: DEBUG: ", @_, "\n" or die $!;
+}
+
+sub debug_cmd {
+    debug "running ", join ' ',
+        map { 
+           if (m/[^-_.=+0-9a-z]/i) {
+               my $s = $_;
+               $s =~ s/['\\]/'\\$&'/g;
+               "'$s'";
+           } else {
+               $_;
+           }
+       } @_;
+}
+
 sub comment_make ($) {
     my ($num) = @_;
     my $r = $comment_pattern;
@@ -45,16 +66,20 @@ sub comment_make ($) {
 
 sub run_generator {
     my @genargs = @_;
-    open P, "-|", $generator, @genargs or fail "fork $generator: $!";
+    my @cmd = ($generator, @genargs);
+    debug_cmd @cmd;
+    open P, "-|", @cmd or fail "fork $generator: $!";
     while (<P>) {
        my ($alias,$comment);
+       chomp or fail "$generator truncated output?";
+       debug "| ", $_;
        if (m/^\# user/) {
            next;
        } elsif (m/^\# reject (\S+) (\#.*)$/) {
            ($alias,$comment) = ($1,$2);
        } elsif (m/^\#/) {
            next; # future extension
-       } elsif (m/^([^#: ])\: [^#]* (\#.*)$/) {
+       } elsif (m/^([^#: ]+)\: [^#]* (\#.*)$/) {
            ($alias,$comment) = ($1,$2);
        } else {
            die "generator output $_ ?";
@@ -81,9 +106,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];
@@ -91,13 +116,13 @@ sub perhaps_generate ($) {
     return $alias;
 }
 
-sub parse_target {
+sub parse_target () {
     @ARGV or badusage "missing specification for alias to change";
     my $spec = shift @ARGV;
     my $target;
     if ($spec =~ m/^(\d{1,9})$/) {
        $target = $by_number[$spec];
-       fail "no alias number $target" unless $target;
+       fail "no alias number $spec (already assigned perhaps?)" unless $target;
     } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
        $target = $by_localpart{$1};
        fail "no alias with local part \`$1'" unless $target;
@@ -107,17 +132,19 @@ sub parse_target {
     } else {
        badusage "bad specification for alias to change";
     }
+    return $target;
 }
 
 sub report ($) {
     my ($alias) = @_;
     confess unless $alias;
-    print $alias->{Number}, ' ', $alias->{LocalPart}, "\n"
+    print $alias->{Number}, ' ',
+        $alias->{ $show_domain ? 'Alias' : 'LocalPart' }, "\n"
        or failstdout;
 }
 
 sub action_update {
-    my $target = parse_target;
+    my $target = parse_target();
     @ARGV or badusage "missing update info\n";
     if (defined $target->{Number} && $target->{Number} == $#by_number) {
        my $wanted = $#by_number + 1;
@@ -127,8 +154,9 @@ $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
-       or fail "exec $generator: $!";
+    my @cmd = ($generator, qw(update), $target->{Alias}, @ARGV);
+    debug_cmd @cmd;
+    exec @cmd or fail "exec $generator: $!";
 }
 
 sub action_assign {
@@ -142,7 +170,8 @@ sub action_list {
     @ARGV==0 or
        badusage "invalid arguments to list";
     my $num = $min_number;
-    while ($num <= $#by_number) {
+    $num ||= 0;
+    for (; $num <= $#by_number; $num++) {
        my $alias = $by_number[$num];
        report $alias if $alias;
     }
@@ -154,14 +183,19 @@ sub action_some {
      badusage "invalid arguments to some";
     my ($count) = $1;
     my $num = $min_number;
-    while ($count > 0) {
-       my $alias = generate $num;
+    $num ||= 0;
+    for (; $count > 0; $num++) {
+       my $alias = perhaps_generate $num;
        if ($alias) {
            report $alias;
            $count--;
        } else {
-           last if $num > $#by_number; # -N
-           $num++;
+           if ($num > $#by_number) {
+               print STDERR <<END or fail "stderr: $!";
+$us: fewer than requested aliases printed, due to -N
+END
+               last;
+           }
        }
     }
 }
@@ -176,7 +210,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;
     }
 }    
@@ -191,6 +225,10 @@ for (;;) {
            push @genopts, $arg;
        } elsif ($arg =~ s/^-G(.*)//) {
            $generator = $1;
+       } elsif ($arg =~ s/^-D/-/) {
+           open DEBUG, ">&STDERR" or die $!;
+       } elsif ($arg =~ s/^-q/-/) {
+           $show_domain = 0;
        } elsif ($arg =~ s/^-N/-/) {
            $no_generate = 1;
        } else {
@@ -210,11 +248,14 @@ $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 #'
+($comment_re =~ s'\\<number\\>'(0|[1-9]\d{0,8})'g) == 1 #'
     or badusage "comment pattern (\`$comment_pattern')".
          " must contain \`<number>' exactly once";
 
-@ARGV or badusage "missing action";
+if (!@ARGV) {
+    print STDERR $usage or die $!;
+    exit 1;
+}
 my $action = shift @ARGV;
 
 fetch_list();