4 our $us = $0; $us =~ s#.*/##;
7 $us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
8 $us [<opts>] assign <number>|<localpart>@[domain] <comment>
10 $us [<opts>] some <count> } will generate aliases
11 $us [<opts>] range <min>-<max>|<min>+<count> } as necessary
13 -G<generator> generator/lister program
14 -N do not generate more aliases
15 -l.., -d.., -F.., -m.. passed to generator
17 Always use $us to edit the comment of a pregen alias;
18 otherwise we may lose track of the next number alias to pregenerate
20 <comment> must always start with #, and you will need to quote the
21 whole comment to protect it from your shell
24 sub fail { die "$us: @_\n"; }
25 sub badusage { fail "bad usage: @_"; }
26 sub failstdout () { fail "stdout: $!"; }
36 our $comment_pattern = '### PREGEN <number>';
39 sub comment_make ($) {
41 my $r = $comment_pattern;
42 ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
48 open P, "-|", $generator, @genargs or fail "fork $generator: $!";
53 } elsif (m/^\# reject (\S+) (\#.*)$/) {
54 ($alias,$comment) = ($1,$2);
56 next; # future extension
57 } elsif (m/^([^#: ])\: [^#]* (\#.*)$/) {
58 ($alias,$comment) = ($1,$2);
60 die "generator output $_ ?";
62 my $localpart = $alias;
63 $localpart =~ s/\@.*//;
64 my $row = { Alias => $alias, LocalPart => $localpart };
65 if ($comment =~ m/^$comment_re$/o) {
68 $by_localpart{$row->{LocalPart}} = $row;
69 if (defined $row->{Number}) {
70 $by_number[$row->{Number}] = $row;
71 $min_number = $row->{Number} if
72 (!defined $min_number) || $min_number > $row->{Number};
75 $?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n";
79 run_generator qw(list);
82 sub perhaps_generate ($) {
84 my $alias = $by_number[$num];
85 return $alias if $alias;
86 return undef if $no_generate;
87 return undef unless $num > $#by_number;
88 run_generator qw(create), (comment_make $num);
89 $alias = $by_number[$num];
90 confess "$num ?" unless $alias;
95 @ARGV or badusage "missing specification for alias to change";
96 my $spec = shift @ARGV;
98 if ($spec =~ m/^(\d{1,9})$/) {
99 $target = $by_number[$spec];
100 fail "no alias number $target" unless $target;
101 } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
102 $target = $by_localpart{$1};
103 fail "no alias with local part \`$1'" unless $target;
104 fail "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'"
105 unless $spec eq $target->{Alias} ||
106 $spec eq $target->{LocalPart}.'@';
108 badusage "bad specification for alias to change";
114 confess unless $alias;
115 print $alias->{Number}, ' ', $alias->{LocalPart}, "\n"
120 my $target = parse_target;
121 @ARGV or badusage "missing update info\n";
122 if (defined $target->{Number} && $target->{Number} == $#by_number) {
123 my $wanted = $#by_number + 1;
124 perhaps_generate $wanted
125 or print STDERR <<END or fail "stderr: $!"
126 $us: Losing track of next number ($wanted), due to use of -N;
127 $us: will start next alias at #0, unless you say (e.g.) "range $wanted".
130 exec $generator, qw(update), $target->{Alias}, @ARGV
131 or fail "exec $generator: $!";
136 $ARGV[1] =~ m/^#/) or
137 badusage "invalid arguments to assign - forgot to quote it properly?";
143 badusage "invalid arguments to list";
144 my $num = $min_number;
146 while ($num <= $#by_number) {
147 my $alias = $by_number[$num];
148 report $alias if $alias;
154 $ARGV[0] =~ m/^(\d+)$/s) or
155 badusage "invalid arguments to some";
157 my $num = $min_number;
160 my $alias = perhaps_generate $num;
165 if ($num > $#by_number) {
166 print STDERR <<END or fail "stderr: $!";
167 $us: fewer than requested aliases printed, due to -N
178 $ARGV[0] =~ m/^(\d+)(?:([-+])(\d+))?$/s) or
179 badusage "invalid arguments to range";
180 my ($num,$op,$rarg) = ($1,$2,$3);
182 $op eq '+' ? $num+$rarg-1 :
185 for (; $num<=$limit; $num++) {
186 my $alias = perhaps_generate $num;
187 report $alias if $alias;
193 last unless $ARGV[0] =~ m/^-/;
194 my $arg = shift @ARGV;
195 last if $arg =~ m/^--?$/;
196 while ($arg =~ m/^-./) {
197 if ($arg =~ s/^-[ldFm]/-/) {
199 } elsif ($arg =~ s/^-G(.*)//) {
201 } elsif ($arg =~ s/^-N/-/) {
204 badusage "unknown option \`$arg'";
209 if (!defined $generator) {
211 $generator =~ s/-pregen$//
212 or fail "unable to calculate default generator".
213 " (want to strip \`-pregen' from our program name, \`$us')";
216 $comment_pattern =~ m/^#/s
217 or badusage "comment pattern must start with \`#'";
218 $comment_re = $comment_pattern;
219 $comment_re =~ s/\W/\\$&/g;
220 ($comment_re =~ s'\\<number\\>'([1-9]\d{0,8})'g) == 1 #'
221 or badusage "comment pattern (\`$comment_pattern')".
222 " must contain \`<number>' exactly once";
224 @ARGV or badusage "missing action";
225 my $action = shift @ARGV;
231 { no strict qw(refs); $actionsub = \&{"action_$action"}; }
232 defined $actionsub or badusage "unknown action $action";
235 close STDOUT or failstdout;