package Qpsmtpd::Aliases;
use strict;
use Time::HiRes qw(time);
use Data::Dumper;

sub new {
    my ($class, %options) = @_;

    my $self = {};
    bless $self, $class;

    if ($options{logger}) {
	$self->{logger} = $options{logger};
    }
    if ($options{configdir}) {
	$self->{configdir} = $options{configdir};
    } else {
	my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
	$self->{configdir} = "$QPHOME/config";
    }
    if ($options{loglevel}) {
	$self->{loglevel} = $options{loglevel};
    } else {
	$self->{loglevel} = 0;
    }

    $self->parse_all();

    return $self;
}

sub log {
    my ($self, $level, @msg) = @_;
    if ($self->{logger}) {
	$self->{logger}->log($level, @msg);
    } else {
	print STDERR "$0 [$level] @msg\n" if ($level <= $self->{loglevel});
    }
}

sub parse_file {
    my ($self, $file) = @_;

    my $t0 = time();
    open(UL, "<$file");
    while (<UL>) {
	s/#.*//;
	my $options;
	if (/(.*)\((.*)\)/) {
	    # options are parenthesized 
	    $options = $2;
	    $_ = $1;
	}
	s/\s+//gs;
	next if /^$/;
	my ($alias, $exp) = split(/:/);
	my ($a_local, $a_dom) = split(/\@/, $alias);
	my @locals = split(/,/, $a_local);
	my @domains = split(/,/, $a_dom);
	my @exp = split(/,/, $exp);
	for my $l (@locals) {
	    for my $d (@domains) {
		$self->{al}{"$l\@$d"}{exp} = [@exp];
		if ($options) {
		    my @opt = split(/,/, $options);
		    for my $o (@opt) {
			if ($o =~ m/(.*?)=(.*)/) {
			    my ($k, $v) = ($1, $2);
			    $k =~ s/^\s*(.*?)\s*$/$1/;
			    $v =~ s/^\s*(.*?)\s*$/$1/;
			    $self->{al}{"$l\@$d"}{opt}{$k} = $v;
			    $self->log(7, "aliases: parse_al: option <$k>=<$v>");
			} else {
			    $o =~ s/^\s*(.*?)\s*$/$1/;
			    $self->{al}{"$l\@$d"}{opt}{$o} = 1;
			    $self->log(7, "aliases: parse_al: option <$o>");
			}
		    }
		}
	    }
	}
    }
    close(UL);
    my $t1 = time();

    $self->log(6, "parsed $file in ", $t1 - $t0, " seconds")
}


sub parse_all {
    my ($self) = @_;

    my $t0 = time();
    for my $file ("$self->{configdir}/aliases", glob("$self->{configdir}/aliases.d/*")) {
	$self->parse_file($file);
    }
    my $t1 = time();

    $self->log(6, "parsed aliases file(s) in ", $t1 - $t0, " seconds")

}


sub expand_alias {
    my ($self, $alias, $detail, $null_ok, $seen) = @_;
    my $exp = undef;

    $self->log(6, "expand_alias($alias, " . ($detail || 'undef'), ", ", ($null_ok || 'undef'), ", {" . join(', ', keys %$seen) . "})");

    # check for infinite recursion
    return [ $alias] if ($seen->{$alias});
    $seen = { %$seen, $alias => 1 };

    my $t0 = time();
    $self->log(6, "trying to expand '$alias'");
    my $e = $self->{al}{$alias}{exp};
    $self->log(6, "result = " . ($e || "undef"));

    if ($e) {
	$self->log(6, "success -> recursing");
	for (@$e) {
	    my $e1 = $self->expand_alias($_, $detail, 1, $seen);
	    push @$exp, @$e1;
	}
    } else {
	$self->log(6, "failure -> trying wildcard");
    
	$alias =~ m/(.*)@(.*)/;
	my ($local, $domain) = ($1, $2);
	$self->log(6, "trying to expand '*\@$domain'");
	$e = $self->{al}{"*\@$domain"}{exp};
	$self->log(6, "result = " . ($e || "undef"));
	if ($e) {
	    $self->log(6, "success (wildcard) -> recursing");
	    for (@$e) {
		my ($mailbox, $server) = split(/@/);
		$_ = $mailbox . ($detail ? "+$detail" : "") .
		    '@' . $server;
		s/\*/$local/;
		($mailbox, $server) = split(/@/);
		if ($mailbox =~ m/(.*?)\+(.*)/) {
		    $mailbox = $1;
		    $detail = $2;
		}
		$_ = "$mailbox\@$server";
		my $e1 = $self->expand_alias($_, $detail, 1, $seen);
		push @$exp, @$e1;
	    }
	} elsif ($null_ok) {
	    $self->log(6, "failure on wildcard but null_ok -> returning");
	    my ($mailbox, $server) = split(/@/, $alias);
	    $exp = [ 
		    $mailbox . ($detail ? "+$detail" : "") .
		    '@' . $server
		   ];
	}
    }
    my $t1 = time();
    $self->log(5, "$alias expanded to ",
		 ($exp ? scalar(@$exp) : 0), " recipients in : ",
		 $t1 - $t0, " seconds\n");
    return $exp;
}


sub alias_options {
    my ($self, $alias) = @_;

    $self->log(6, "looking up options for $alias");
    my $opt = $self->{al}{$alias}{opt};
    if ($opt) {
	my $d = Data::Dumper->new([$opt], ['opt']);
	$d->Indent(0)->Terse(1);
	$self->log(6, "found options: " . $d->Dump);
	return $opt
    }

    $alias =~ m/(.*)@(.*)/;
    my ($local, $domain) = ($1, $2);
    $opt = $self->{al}{"*\@$domain"}{opt};
    if ($opt) {
	my $d = Data::Dumper->new([$opt], ['opt']);
	$d->Indent(0)->Terse(1);
	$self->log(6, "found options: " . $d->Dump);
	return $opt
    } else {
	$self->log(6, "found no options");
	return undef;
    }
}

1;
