#! /usr/bin/perl
# -*- Perl -*-

require 'stat.pl';

# scarf up the addresses that email considers deliverable
while(($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) =
      getpwent()) {
    if (!-e $dir) {
	# ${name}'s home dir, $dir, doesn't exist, skipping.
	next;
    }
    &Stat($dir);
    if ($uid != $st_uid) {
        #$name is $uid, but $dir is owned by $st_uid, skipping.
	next;
    }
    $realuser{$name} = $dir;
}
endpwent();

$leading_comment = 1;
while(<>) {
    chop;
    if (s/\\$// || m/,\s*$/) {	# if a trailing backslash,
        $_ .= <>;               # append another line,
        redo;                   # and keep going
    }
    next if m/^\s*$/;		# delete all blank lines.
    next if m/^\#/ && $leading_comment; # delete leading comments -- probably sendmail cruft.
    $leading_comment = 0;

    s/([\w.-]+)://;             # slurp up the name of the alias
    $alias = $1;
    $alias =~ s/\./:/g;
    $alias = lc($alias);
    @alias = ();
    while($_) {
        s/^\s*//;               # nuke leading blanks
        next if s/^,//;         # skip empty aliases
        if (s/^\"([^\"]+)\"//) {
	    push(@alias, $1);       # suck down quoted material
        } elsif ( s/^(\#.*)$// ) {
            push(@alias,$1);        # comment (why do I have this here?)
        } elsif ( s/^<>\s// ) {
            # sendmail-IDA's <> construct (discard it)
        } elsif ( s/^([^,\s]+)// ) {
            push(@alias,$1);        # user names and filenames
        } else {
            $alias = "Uh-oh, nothing matched.";
        }
    }
    if (defined($realuser{$alias})) {
	$fn = "$realuser{$alias}/.qmail";
    } else {
	$fn = ".qmail-$alias";
    }
    if (scalar(@alias) == 1 && $alias[0] =~ m/#/) {
	push(@comment, $alias[0]) if $alias[0] =~ m/#.+/;
	next;
    }
    unshift(@alias, @comment);
    @comment = ();
    if (scalar(@alias) == 1) {
	print "echo '@alias[0]' >$fn\n" if $alias ne @alias[0];
    } else {
	print "cat >$fn <<EOF\n";
	$last="";
	foreach (sort(@alias)) {
	    print "$_\n" if $_ ne $last;
	    $last = $_;
	}
	print "EOF\n";
    }
}
#foreach $i (keys %realuser) {
#    print "$i=$realuser{$i}\n";
#}

.