package Qpsmtpd::ConfigRE;

use Qpsmtpd::Constants;
use vars qw(@ISA @EXPORT);
use Exporter qw(import);
@ISA    = qw(Exporter);
@EXPORT = qw(configure check);

sub configure {
    my ($self, $config, $def_const, $def_comment) = @_;
    
    $def_comment ||= "";

    my ($re, $const, $comment, $str, $ok, $err);

    foreach ($self->qp->config($config)) {
        s/^\s*//;
        ($re, $const, $comment) = split /\s+/, $_, 3;
        $str = undef;

        if ($re =~ m#^/(.*)/$#) { ## <-- vim syntax fix
            $re = $1;
            $ok = eval { $re = qr/$re/i; };
            if ($@) {
                ($err = $@) =~ s/\s*at \S+ line \d+\.\s*$//;
                $self->qp->log(LOGWARN, 
                        $self->plugin_name.": REGEXP '$re' not valid: $err");
                next;
            }
            $re = $ok;
        }
        else {
            $str = lc $re;
        }

        unless (defined $const) {
            if ($def_const) {
                $const = $def_const;
            }
            else {
                $self->qp->log(LOGWARN, 
                                $self->plugin_name.": no return code");
                next;
            }
        }
        $ok    = $const;
        $const = Qpsmtpd::Constants::return_code($const);
        unless (defined $const) {
            $self->qp->log(LOGWARN, 
                        $self->plugin_name.": '$ok' is not a valid constant");
        }
        
        my $cfg = { 
                const   => $const, 
                comment => (defined $comment) ? $comment : $def_comment,
            };
        if (defined $str) { 
            $cfg->{str} = $str; 
        }
        else {
            $cfg->{re} = $re;
        }
        push @{$self->{_config_re}}, $cfg;
    }
}

sub check { 
    my ($self, $arg) = @_;
    $arg = lc $arg;
    my $comment = "";

    for (@{$self->{_config_re}}) {
        if (exists $_->{re}) { 
            next unless $arg =~ $_->{re}; 

            $comment = $_->{comment} || "";
            if (index($comment, '%s') != -1) {
                $comment = sprintf($comment, $arg);
            }

            $self->qp->log(LOGDEBUG, 
                $self->plugin_name.": '$arg' matched ".$_->{re}.", returning "
                .Qpsmtpd::Constants::return_code($_->{const})." => $comment");
        }
        else {  
            next unless $arg eq $_->{str};

            $comment = $_->{comment} || "";
            if (index($comment, '%s') != -1) {
                $comment = sprintf($comment, $arg);
            }

            $self->qp->log(LOGDEBUG, 
                $self->plugin_name.": '$arg' is eq '".$_->{str}."', returning "
                .Qpsmtpd::Constants::return_code($_->{const})." => $comment");
        }
        return $_->{const}, $comment;
    }
    return (DECLINED);
}

=head1 EXAMPLES

 ## rcpt_regexp:
 use Qpsmtpd::ConfigRE;
 
 sub register {
    my ($self, $qp, @args) = @_;
    $self->configure("rcpt_regexp");
 }
 
 sub hook_rcpt {
    my ($self, $transaction, $recipient) = @_;
    return (DECLINED)
      unless $recipient->host && $recipient->user;
    
    return $self->check(
            lc $recipient->user . '@' . $recipient->host
        );
 }

 ## check_spamhelo:
 use Qpsmtpd::ConfigRE;
 
 sub register {
    my ($self, $qp, @args) = @_;
    my $self->configure(
                "badhelo", # name of config file
                # defaults to support the old check_spamhelo:
                "DENY", # a STRING, not the constant itself
                q{Sorry, I don't believe that you are %s.}
                # %s will be replaced by the (HE|EH)LO hostname
            );
 }
 
 sub hook_helo {
    my ($self, $transaction, $host) = @_;
    ($host = lc $host) or return DECLINED;
    return $self->check($host);
 }
 
 # also support EHLO
 *hook_ehlo = \&hook_helo;

=cut

1;
# vim: ts=4 sw=4 expandtab syn=perl