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;
our $generator;
our $no_generate=0;
+our $show_domain=1;
our @genopts;
our %by_localpart;
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;
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 $_ ?";
$by_number[$row->{Number}] = $row;
$min_number = $row->{Number} if
(!defined $min_number) || $min_number > $row->{Number};
+ }
}
$?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n";
}
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];
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;
} 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;
$us: will start next alias at #0, unless you say (e.g.) "range $wanted".
END
}
- exec $generator, qw(update), $target->{Alias}, @ARGV;
- fail "exec $generator: $!";
+ my @cmd = ($generator, qw(update), $target->{Alias}, @ARGV);
+ debug_cmd @cmd;
+ exec @cmd or fail "exec $generator: $!";
}
sub action_assign {
@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;
}
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;
+ }
}
}
}
$op eq '-' ? $rarg :
confess "$op ??";
for (; $num<=$limit; $num++) {
- my $alias = generate $num;
+ my $alias = perhaps_generate $num;
report $alias if $alias;
}
}
last unless $ARGV[0] =~ m/^-/;
my $arg = shift @ARGV;
last if $arg =~ m/^--?$/;
- while ($arg !~ m/^-$/) {
+ while ($arg =~ m/^-./) {
if ($arg =~ s/^-[ldFm]/-/) {
push @genopts, $arg;
- } elsif ($arg =~ s/^-G//) {
- $generator = $'; #';
- } elsif ($arg =~ s/^-N//) {
+ } 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 {
badusage "unknown option \`$arg'";
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";
+($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\n";
+if (!@ARGV) {
+ print STDERR $usage or die $!;
+ exit 1;
+}
my $action = shift @ARGV;
fetch_list();
$action =~ y/-/_/;
-my $actionsub = { no strict qw(refs); \&{"action_$action"}; }
+my $actionsub;
+{ no strict qw(refs); $actionsub = \&{"action_$action"}; }
defined $actionsub or badusage "unknown action $action";
$actionsub->();