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 -q do not show domain, just local part
16 -l.., -d.., -F.., -m.. passed to generator
18 Always use $us to edit the comment of a pregen alias;
19 otherwise we may lose track of the next number alias to pregenerate
21 <comment> must always start with #, and you will need to quote the
22 whole comment to protect it from your shell
25 sub fail { die "$us: @_\n"; }
26 sub badusage { fail "bad usage: @_"; }
27 sub failstdout () { fail "stdout: $!"; }
38 our $comment_pattern = '### PREGEN <number>';
41 open DEBUG, ">/dev/null" or die $!;
44 print DEBUG "$us: DEBUG: ", @_, "\n" or die $!;
48 debug "running ", join ' ',
50 if (m/[^-_.=+0-9a-z]/i) {
52 $s =~ s/['\\]/'\\$&'/g;
60 sub comment_make ($) {
62 my $r = $comment_pattern;
63 ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
69 my @cmd = ($generator, @genargs);
71 open P, "-|", @cmd or fail "fork $generator: $!";
74 chomp or fail "$generator truncated output?";
78 } elsif (m/^\# reject (\S+) (\#.*)$/) {
79 ($alias,$comment) = ($1,$2);
81 next; # future extension
82 } elsif (m/^([^#: ]+)\: [^#]* (\#.*)$/) {
83 ($alias,$comment) = ($1,$2);
85 die "generator output $_ ?";
87 my $localpart = $alias;
88 $localpart =~ s/\@.*//;
89 my $row = { Alias => $alias, LocalPart => $localpart };
90 if ($comment =~ m/^$comment_re$/o) {
93 $by_localpart{$row->{LocalPart}} = $row;
94 if (defined $row->{Number}) {
95 $by_number[$row->{Number}] = $row;
96 $min_number = $row->{Number} if
97 (!defined $min_number) || $min_number > $row->{Number};
100 $?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n";
104 run_generator qw(list);
107 sub perhaps_generate ($) {
109 my $alias = $by_number[$num];
110 return $alias if $alias;
111 return undef if $no_generate;
112 return undef unless $num > $#by_number;
113 run_generator qw(create), (comment_make $num);
114 $alias = $by_number[$num];
115 confess "$num ?" unless $alias;
119 sub parse_target () {
120 @ARGV or badusage "missing specification for alias to change";
121 my $spec = shift @ARGV;
123 if ($spec =~ m/^(\d{1,9})$/) {
124 $target = $by_number[$spec];
125 fail "no alias number $spec (already assigned perhaps?)" unless $target;
126 } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
127 $target = $by_localpart{$1};
128 fail "no alias with local part \`$1'" unless $target;
129 fail "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'"
130 unless $spec eq $target->{Alias} ||
131 $spec eq $target->{LocalPart}.'@';
133 badusage "bad specification for alias to change";
140 confess unless $alias;
141 print $alias->{Number}, ' ',
142 $alias->{ $show_domain ? 'Alias' : 'LocalPart' }, "\n"
147 my $target = parse_target();
148 @ARGV or badusage "missing update info\n";
149 if (defined $target->{Number} && $target->{Number} == $#by_number) {
150 my $wanted = $#by_number + 1;
151 perhaps_generate $wanted
152 or print STDERR <<END or fail "stderr: $!"
153 $us: Losing track of next number ($wanted), due to use of -N;
154 $us: will start next alias at #0, unless you say (e.g.) "range $wanted".
157 my @cmd = ($generator, qw(update), $target->{Alias}, @ARGV);
159 exec @cmd or fail "exec $generator: $!";
164 $ARGV[1] =~ m/^#/) or
165 badusage "invalid arguments to assign - forgot to quote it properly?";
171 badusage "invalid arguments to list";
172 my $num = $min_number;
174 for (; $num <= $#by_number; $num++) {
175 my $alias = $by_number[$num];
176 report $alias if $alias;
182 $ARGV[0] =~ m/^(\d+)$/s) or
183 badusage "invalid arguments to some";
185 my $num = $min_number;
187 for (; $count > 0; $num++) {
188 my $alias = perhaps_generate $num;
193 if ($num > $#by_number) {
194 print STDERR <<END or fail "stderr: $!";
195 $us: fewer than requested aliases printed, due to -N
205 $ARGV[0] =~ m/^(\d+)(?:([-+])(\d+))?$/s) or
206 badusage "invalid arguments to range";
207 my ($num,$op,$rarg) = ($1,$2,$3);
209 $op eq '+' ? $num+$rarg-1 :
212 for (; $num<=$limit; $num++) {
213 my $alias = perhaps_generate $num;
214 report $alias if $alias;
220 last unless $ARGV[0] =~ m/^-/;
221 my $arg = shift @ARGV;
222 last if $arg =~ m/^--?$/;
223 while ($arg =~ m/^-./) {
224 if ($arg =~ s/^-[ldFm]/-/) {
226 } elsif ($arg =~ s/^-G(.*)//) {
228 } elsif ($arg =~ s/^-D/-/) {
229 open DEBUG, ">&STDERR" or die $!;
230 } elsif ($arg =~ s/^-q/-/) {
232 } elsif ($arg =~ s/^-N/-/) {
235 badusage "unknown option \`$arg'";
240 if (!defined $generator) {
242 $generator =~ s/-pregen$//
243 or fail "unable to calculate default generator".
244 " (want to strip \`-pregen' from our program name, \`$us')";
247 $comment_pattern =~ m/^#/s
248 or badusage "comment pattern must start with \`#'";
249 $comment_re = $comment_pattern;
250 $comment_re =~ s/\W/\\$&/g;
251 ($comment_re =~ s'\\<number\\>'(0|[1-9]\d{0,8})'g) == 1 #'
252 or badusage "comment pattern (\`$comment_pattern')".
253 " must contain \`<number>' exactly once";
256 print STDERR $usage or die $!;
259 my $action = shift @ARGV;
265 { no strict qw(refs); $actionsub = \&{"action_$action"}; }
266 defined $actionsub or badusage "unknown action $action";
269 close STDOUT or failstdout;