pregen: wip: before introduce run_generator

diff --git a/evade-mail-pregen b/evade-mail-pregen
old mode 100644 (file)
new mode 100755 (executable)
index ca1e6a7..d98337b
--- a/evade-mail-pregen
+++ b/evade-mail-pregen
@@ -1,18 +1,18 @@
 #!/usr/bin/perl -w
 use strict;
-our $pgm = $0; $pgm =~ s#.*/##;
+our $us = $0; $us =~ s#.*/##;
 our $usage = <<'END';
 usage:
- $pgm [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
- $pgm [<opts>] assign <number>|<localpart>@[domain] <comment>
- $pgm [<opts>] show <count>              } will generate more aliases
- $pgm [<opts>] range [<from>-[<to>]]     }  if necessary
+ $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
 opts:
  -G<generator>           generator/lister program
  -N                      do not generate more aliases
  -l.., -d.., -F.., -m..  passed to generator
 notes:
- Always use $pgm to edit the comment of a pregen alias;
+ Always use $us to edit the comment of a pregen alias;
   otherwise we may lose track of the next number alias to pregenerate
   and reuse numbers.
  <comment> must always start with #, and you will need to quote the
@@ -20,8 +20,22 @@ notes:
 END
 
 our $generator;
+our $no_generate=0;
 our @genopts;
 
+our %by_localpart;
+our @by_number;
+
+our $comment_pattern = '### PREGEN <number>';
+our $comment_re;
+
+sub comment_make ($) {
+    my ($num) = @_;
+    my $r = $comment_pattern;
+    ($r =~ s/\<number\>/$num/) == 1 or die "$r ?";
+    return $r;
+}
+
 sub fetch_list {
     open P, "-!", $generator, qw(list) or die $!;
     while (<P>) {
@@ -40,13 +54,23 @@ sub fetch_list {
        my $localpart = $alias;
        $localpart =~ s/\@.*//;
        my $row = { Alias => $alias, LocalPart => $localpart };
-       if ($comment =~ m/^### PREGEN ([1-9]\d{0,8})$/) {
+       if ($comment =~ m/^$comment_re$/o) {
            $row->{Number}= $1;
        }
        $by_localpart{$row->{LocalPart}} = $row;
        $by_number[$row->{Number}] = $row if defined $row->{Number};
     }
     $?=0; $!=0; close P or die "$generator $! $?";
+}
+
+sub 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 ($! $?)";
     
 }
 
@@ -72,7 +96,12 @@ sub action_update {
     my $target = parse_target;
     @ARGV or badusage "missing update info\n";
     if (defined $target->{Number} && $target->{Number} == $#by_number) {
-       generate $target->{Number}+1;
+       my $wanted = $target->{Number}+1;
+       generate $wanted
+           or print STDERR <<END
+$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: $!";
@@ -85,27 +114,34 @@ sub action_assign {
     action_update;
 }
 
-
-    (@ARGV==1 && $ARGV[0] =~  or badusage "missing assignment info (new comment)";
-    $ARGV[0]=~
-
 for (;;) {
     last unless @ARGV;
     last unless $ARGV[0] =~ m/^-/;
     my $arg = shift @ARGV;
     last if $arg =~ m/^--?$/;
-    if ($arg =~ m/^-[ldFm]/) {
-       push @genopts, $arg;
-    } elsif ($arg =~ m/^-G/) {
-       $generator = $'; #';
-    } else {
-       badusage "unknown option \`$arg'";
+    while ($arg !~ m/^-$/) {
+       if ($arg =~ s/^-[ldFm]/-/) {
+           push @genopts, $arg;
+       } elsif ($arg =~ s/^-G//) {
+           $generator = $'; #';
+       } elsif ($arg =~ s/^-N//) {
+           $no_generate = 1;
+       } else {
+           badusage "unknown option \`$arg'";
+       }
     }
 }
 
-our $child = $pgm;
+our $child = $us;
 $child =~ s/-pregen/; fixme fixme this should be defaulting generator
 
+$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";
+
 @ARGV or badusage "missing action\n";
 my $action = shift @ARGV;
 $action =~ y/-/_/;