qpsmtpd/t/plugin_tests/user_config

#!perl -w

use strict;
use warnings;
use File::Path;
use Qpsmtpd::Constants;

BEGIN {    # need this to happen before anything else
    my $cwd = `pwd`;
    chomp($cwd);
    open my $spooldir, '>', "./config.sample/spool_dir";
    print $spooldir "$cwd/t/tmp";
    close $spooldir;
}

sub register_tests {
    my ($self) = @_;
    $self->register_test('test_hook_user_config', 4);
}

sub test_hook_user_config {
    my ($self) = @_;
    my $dirname = $self->qp->temp_dir;
    $self->{pattern} = $dirname . '/%u_%h_%a';
    $dirname .= '/testuser_testhost_testaddress';
    -d $dirname
      or mkdir($dirname, 0700)
      or die "Could not create $dirname: $!";
    open my $fh, '>', "$dirname/testfield";
    print $fh "testdata";
    close $fh;
    my $a = FakeAddress->new(
                             user    => 'testuser',
                             host    => 'testhost',
                             address => 'testaddress'
                            );
    my ($r, $value) =
      $self->hook_user_config($self->qp->transaction, $a, 'testfield');
    is($r, OK, 'hook_user_config returned OK when config file present');
    is($value, 'testdata', 'hook_user_config returned the correct value');
    ($r, $value) =
      $self->hook_user_config($self->qp->transaction, $a, 'noconfig');
    is($r, DECLINED,
        'hook_user_config returned DECLINED when no config file present');
    is($value, undef,
        'hook_user_config returned no value when no config file present');
    rmtree($dirname);
}

package FakeAddress;

sub new {
    shift;
    return bless {@_};
}
sub address { return shift->{address} }
sub user    { return shift->{user} }
sub host    { return shift->{host} }