#!/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
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;
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+) (\#.*)$/) {
$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 {
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 {
}
}
+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 {
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/^-/;
}
}
-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 \`#'";
@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;