#!/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>] 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
 -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;
  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
  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 $show_domain=1;
our @genopts;

our %by_localpart;
our @by_number;
our $min_number;

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;
    ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
    return $r;
}

sub run_generator {
    my @genargs = @_;
    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/^([^#: ]+)\: [^#]* (\#.*)$/) {
	    ($alias,$comment) = ($1,$2);
	} else {
	    die "generator output $_ ?";
	}
	my $localpart = $alias;
	$localpart =~ s/\@.*//;
	my $row = { Alias => $alias, LocalPart => $localpart };
	if ($comment =~ m/^$comment_re$/o) {
	    $row->{Number}= $1;
	}
	$by_localpart{$row->{LocalPart}} = $row;
	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 fail "$generator $genargs[0] failed ($! $?)\n";
}

sub fetch_list () {
    run_generator qw(list);
}

sub perhaps_generate ($) {
    my ($num) = @_;
    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];
    confess "$num ?" unless $alias;
    return $alias;
}

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 $spec (already assigned perhaps?)" unless $target;
    } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
	$target = $by_localpart{$1};
	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 {
	badusage "bad specification for alias to change";
    }
    return $target;
}

sub report ($) {
    my ($alias) = @_;
    confess unless $alias;
    print $alias->{Number}, ' ',
        $alias->{ $show_domain ? '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 = $#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
    }
    my @cmd = ($generator, qw(update), $target->{Alias}, @ARGV);
    debug_cmd @cmd;
    exec @cmd or fail "exec $generator: $!";
}

sub action_assign {
    (@ARGV==2 &&
     $ARGV[1] =~ m/^#/) or
     badusage "invalid arguments to assign - forgot to quote it properly?";
    action_update;
}

sub action_list {
    @ARGV==0 or
	badusage "invalid arguments to list";
    my $num = $min_number;
    $num ||= 0;
    for (; $num <= $#by_number; $num++) {
	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;
    $num ||= 0;
    for (; $count > 0; $num++) {
	my $alias = perhaps_generate $num;
	if ($alias) {
	    report $alias;
	    $count--;
	} else {
	    if ($num > $#by_number) {
		print STDERR <<END or fail "stderr: $!";
$us: fewer than requested aliases printed, due to -N
END
		last;
	    }
	}
    }
}

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 = perhaps_generate $num;
	report $alias if $alias;
    }
}    

for (;;) {
    last unless @ARGV;
    last unless $ARGV[0] =~ m/^-/;
    my $arg = shift @ARGV;
    last if $arg =~ m/^--?$/;
    while ($arg =~ m/^-./) {
	if ($arg =~ s/^-[ldFm]/-/) {
	    push @genopts, $arg;
	} 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'";
	}
    }
}

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 \`#'";
$comment_re = $comment_pattern;
$comment_re =~ s/\W/\\$&/g;
($comment_re =~ s'\\<number\\>'(0|[1-9]\d{0,8})'g) == 1 #'
    or badusage "comment pattern (\`$comment_pattern')".
         " must contain \`<number>' exactly once";

if (!@ARGV) {
    print STDERR $usage or die $!;
    exit 1;
}
my $action = shift @ARGV;

fetch_list();

$action =~ y/-/_/;
my $actionsub;
{ no strict qw(refs); $actionsub = \&{"action_$action"}; }
defined $actionsub or badusage "unknown action $action";
$actionsub->();

close STDOUT or failstdout;