diff --git a/t/addresses.t b/t/addresses.t index 5fbc375..09272ba 100644 --- a/t/addresses.t +++ b/t/addresses.t @@ -7,35 +7,46 @@ use_ok('Test::Qpsmtpd'); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost'); -is(($smtpd->command('MAIL FROM:'))[0], 250, 'MAIL FROM:'); -is($smtpd->transaction->sender->address, 'ask@perl.org', 'got the right sender'); +is(($smtpd->command('MAIL FROM:'))[0], + 250, 'MAIL FROM:'); +is($smtpd->transaction->sender->address, 'ask@perl.org', + 'got the right sender'); -is(($smtpd->command('MAIL FROM:'))[0], 250, 'MAIL FROM:'); -is($smtpd->transaction->sender->address, 'ask @perl.org', 'got the right sender'); +is(($smtpd->command('MAIL FROM:'))[0], + 250, 'MAIL FROM:'); +is($smtpd->transaction->sender->address, + 'ask @perl.org', + 'got the right sender'); -is(($smtpd->command('MAIL FROM:ask@perl.org'))[0], 250, 'MAIL FROM:ask@perl.org'); -is($smtpd->transaction->sender->format, '', 'got the right sender'); +is(($smtpd->command('MAIL FROM:ask@perl.org'))[0], + 250, 'MAIL FROM:ask@perl.org'); +is($smtpd->transaction->sender->format, + '', 'got the right sender'); -is(($smtpd->command('MAIL FROM:ask@[1.2.3.4]'))[0], 250, 'MAIL FROM:ask@[1.2.3.4]'); -is($smtpd->transaction->sender->format, '', 'got the right sender'); +is(($smtpd->command('MAIL FROM:ask@[1.2.3.4]'))[0], + 250, 'MAIL FROM:ask@[1.2.3.4]'); +is($smtpd->transaction->sender->format, + '', 'got the right sender'); my $command = 'MAIL FROM: SIZE=1230'; is(($smtpd->command($command))[0], 250, $command); -is($smtpd->transaction->sender->format, '', 'got the right sender'); +is($smtpd->transaction->sender->format, + '', 'got the right sender'); $command = 'MAIL FROM:<>'; -is(($smtpd->command($command))[0], 250, $command); +is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '<>', 'got the right sender'); $command = 'MAIL FROM: SIZE=1230'; is(($smtpd->command($command))[0], 250, $command); -is($smtpd->transaction->sender->format, '', 'got the right sender'); +is($smtpd->transaction->sender->format, + '', + 'got the right sender'); $command = 'MAIL FROM: SIZE=1230 CORRECT-WITHOUT-ARG'; is(($smtpd->command($command))[0], 250, $command); $command = 'MAIL FROM:'; -is(($smtpd->command($command))[0], 250, $command); +is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '<>', 'got the right sender'); - diff --git a/t/auth.t b/t/auth.t index d6e23b4..2d2876e 100644 --- a/t/auth.t +++ b/t/auth.t @@ -19,119 +19,121 @@ use_ok('Qpsmtpd::Auth'); my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(); -ok( $smtpd, "get new connection ($smtpd)"); -isa_ok( $conn, 'Qpsmtpd::Connection', "get new connection"); +ok($smtpd, "get new connection ($smtpd)"); +isa_ok($conn, 'Qpsmtpd::Connection', "get new connection"); #warn Dumper($smtpd) and exit; #my $hooks = $smtpd->hooks; #warn Dumper($hooks) and exit; my $r; -my $user = 'good@example.com'; -my $pass = 'good_pass'; -my $enc_plain= Qpsmtpd::Auth::e64( join("\0", '', $user, $pass ) ); +my $user = 'good@example.com'; +my $pass = 'good_pass'; +my $enc_plain = Qpsmtpd::Auth::e64(join("\0", '', $user, $pass)); # get_auth_details_plain: plain auth method handles credentials properly -my ($loginas,$ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $enc_plain); -cmp_ok( $user, 'eq', $user, "get_auth_details_plain, user"); -cmp_ok( $passClear, 'eq', $pass, "get_auth_details_plain, password"); +my ($loginas, $ruser, $passClear) = + Qpsmtpd::Auth::get_auth_details_plain($smtpd, $enc_plain); +cmp_ok($user, 'eq', $user, "get_auth_details_plain, user"); +cmp_ok($passClear, 'eq', $pass, "get_auth_details_plain, password"); -my $bad_auth = Qpsmtpd::Auth::e64( join("\0", 'loginas', 'user@foo', 'passer') ); -($loginas,$ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $bad_auth ); -ok( ! $loginas, "get_auth_details_plain, loginas -"); -ok( !$ruser, "get_auth_details_plain, user -"); -ok( !$passClear, "get_auth_details_plain, pass -"); +my $bad_auth = Qpsmtpd::Auth::e64(join("\0", 'loginas', 'user@foo', 'passer')); +($loginas, $ruser, $passClear) = + Qpsmtpd::Auth::get_auth_details_plain($smtpd, $bad_auth); +ok(!$loginas, "get_auth_details_plain, loginas -"); +ok(!$ruser, "get_auth_details_plain, user -"); +ok(!$passClear, "get_auth_details_plain, pass -"); # these plugins test against whicever loaded plugin provides their selected # auth type. Right now, they end up testing against auth_flat_file. # PLAIN $r = Qpsmtpd::Auth::SASL($smtpd, 'plain', $enc_plain); -cmp_ok( OK, '==', $r, "plain auth"); +cmp_ok(OK, '==', $r, "plain auth"); -if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) { -# same thing, but must be entered interactively +if ($ENV{QPSMTPD_DEVELOPER} && is_interactive()) { + + # same thing, but must be entered interactively print "answer: $enc_plain\n"; $r = Qpsmtpd::Auth::SASL($smtpd, 'plain', ''); - cmp_ok( OK, '==', $r, "SASL, plain"); -}; - + cmp_ok(OK, '==', $r, "SASL, plain"); +} # LOGIN -if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) { +if ($ENV{QPSMTPD_DEVELOPER} && is_interactive()) { - my $enc_user = Qpsmtpd::Auth::e64( $user ); - my $enc_pass = Qpsmtpd::Auth::e64( $pass ); + my $enc_user = Qpsmtpd::Auth::e64($user); + my $enc_pass = Qpsmtpd::Auth::e64($pass); -# get_base64_response + # get_base64_response print "answer: $enc_user\n"; - $r = Qpsmtpd::Auth::get_base64_response( $smtpd, 'Username' ); - cmp_ok( $r, 'eq', $user, "get_base64_response +"); + $r = Qpsmtpd::Auth::get_base64_response($smtpd, 'Username'); + cmp_ok($r, 'eq', $user, "get_base64_response +"); -# get_auth_details_login + # get_auth_details_login print "answer: $enc_pass\n"; - ($ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_login( $smtpd, $enc_user ); - cmp_ok( $ruser, 'eq', $user, "get_auth_details_login, user +"); - cmp_ok( $passClear, 'eq', $pass, "get_auth_details_login, pass +"); + ($ruser, $passClear) = + Qpsmtpd::Auth::get_auth_details_login($smtpd, $enc_user); + cmp_ok($ruser, 'eq', $user, "get_auth_details_login, user +"); + cmp_ok($passClear, 'eq', $pass, "get_auth_details_login, pass +"); print "encoded pass: $enc_pass\n"; $r = Qpsmtpd::Auth::SASL($smtpd, 'login', $enc_user); - cmp_ok( OK, '==', $r, "SASL, login"); -}; - + cmp_ok(OK, '==', $r, "SASL, login"); +} # CRAM-MD5 -if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) { +if ($ENV{QPSMTPD_DEVELOPER} && is_interactive()) { print "starting SASL\n"; -# since we don't have bidirection communication here, we pre-generate a ticket - my $ticket = sprintf( '<%x.%x@%s>', rand(1000000), time(), $smtpd->config('me') ); - my $hash_pass = hmac_md5_hex( $ticket, $pass ); - my $enc_answer = Qpsmtpd::Auth::e64( join(' ', $user, $hash_pass ) ); + # since we don't have bidirection communication here, we pre-generate a ticket + my $ticket = + sprintf('<%x.%x@%s>', rand(1000000), time(), $smtpd->config('me')); + my $hash_pass = hmac_md5_hex($ticket, $pass); + my $enc_answer = Qpsmtpd::Auth::e64(join(' ', $user, $hash_pass)); print "answer: $enc_answer\n"; - my (@r) = Qpsmtpd::Auth::get_auth_details_cram_md5( $smtpd, $ticket ); - cmp_ok( $r[0], 'eq', $ticket, "get_auth_details_cram_md5, ticket" ); - cmp_ok( $r[1], 'eq', $user, "get_auth_details_cram_md5, user" ); - cmp_ok( $r[2], 'eq', $hash_pass, "get_auth_details_cram_md5, passHash" ); -#warn Data::Dumper::Dumper(\@r); + my (@r) = Qpsmtpd::Auth::get_auth_details_cram_md5($smtpd, $ticket); + cmp_ok($r[0], 'eq', $ticket, "get_auth_details_cram_md5, ticket"); + cmp_ok($r[1], 'eq', $user, "get_auth_details_cram_md5, user"); + cmp_ok($r[2], 'eq', $hash_pass, "get_auth_details_cram_md5, passHash"); -# this isn't going to work without bidirection communication to get the ticket - #$r = Qpsmtpd::Auth::SASL($smtpd, 'cram-md5' ); - #cmp_ok( OK, '==', $r, "login auth"); -}; + #warn Data::Dumper::Dumper(\@r); + # this isn't going to work without bidirection communication to get the ticket + #$r = Qpsmtpd::Auth::SASL($smtpd, 'cram-md5' ); + #cmp_ok( OK, '==', $r, "login auth"); +} sub is_interactive { ## no critic -# borrowed from IO::Interactive - my ($out_handle) = ( @_, select ); # Default to default output handle + # borrowed from IO::Interactive + my ($out_handle) = (@_, select); # Default to default output handle -# Not interactive if output is not to terminal... + # Not interactive if output is not to terminal... return if not -t $out_handle; -# If *ARGV is opened, we're interactive if... - if ( openhandle * ARGV ) { + # If *ARGV is opened, we're interactive if... + if (openhandle * ARGV) { -# ...it's currently opened to the magic '-' file + # ...it's currently opened to the magic '-' file return -t *STDIN if defined $ARGV && $ARGV eq '-'; -# ...it's at end-of-file and the next file is the magic '-' file + # ...it's at end-of-file and the next file is the magic '-' file return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV; -# ...it's directly attached to the terminal + # ...it's directly attached to the terminal return -t *ARGV; - }; + } -# If *ARGV isn't opened, it will be interactive if *STDIN is attached -# to a terminal and either there are no files specified on the command line -# or if there are files and the first is the magic '-' file - return -t *STDIN && ( @ARGV == 0 || $ARGV[0] eq '-' ); + # If *ARGV isn't opened, it will be interactive if *STDIN is attached + # to a terminal and either there are no files specified on the command line + # or if there are files and the first is the magic '-' file + return -t *STDIN && (@ARGV == 0 || $ARGV[0] eq '-'); } - __END__ if ( ref $r ) { diff --git a/t/config.t b/t/config.t index 5e674b8..06f5ce0 100644 --- a/t/config.t +++ b/t/config.t @@ -7,15 +7,15 @@ use_ok('Test::Qpsmtpd'); my @mes; -BEGIN { # need this to happen before anything else +BEGIN { # need this to happen before anything else my $cwd = `pwd`; chomp($cwd); @mes = qw{ ./config.sample/me ./t/config/me }; - foreach my $f ( @mes ) { + foreach my $f (@mes) { open my $me_config, '>', $f; print $me_config "some.host.example.org"; close $me_config; - }; + } } ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); @@ -25,12 +25,13 @@ is($smtpd->config('me'), 'some.host.example.org', 'config("me")'); # test for ignoring leading/trailing whitespace (relayclients has a # line with both) my $relayclients = join ",", sort $smtpd->config('relayclients'); -is($relayclients, - '127.0.0.1,192.0.,2001:0DB8,2001:0DB8:0000:0000:0000:0000:0000:0001,2001:DB8::1,2001:DB8::1/32', - 'config("relayclients") are trimmed'); +is( + $relayclients, +'127.0.0.1,192.0.,2001:0DB8,2001:0DB8:0000:0000:0000:0000:0000:0001,2001:DB8::1,2001:DB8::1/32', + 'config("relayclients") are trimmed' + ); -foreach my $f ( @mes ) { +foreach my $f (@mes) { unlink $f if -f $f; -}; - +} diff --git a/t/helo.t b/t/helo.t index f45680e..558130f 100644 --- a/t/helo.t +++ b/t/helo.t @@ -1,4 +1,4 @@ -use Test::More tests => 12; +use Test::More tests => 12; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); diff --git a/t/misc.t b/t/misc.t index 82526bf..496f4e6 100644 --- a/t/misc.t +++ b/t/misc.t @@ -8,10 +8,8 @@ ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); # fault method is(($smtpd->fault)->[0], 451, 'fault returns 451'); is(($smtpd->fault("test message"))->[1], - "Internal error - try again later - test message", - 'returns the input message' - ); - + "Internal error - try again later - test message", + 'returns the input message'); # vrfy command is(($smtpd->command('VRFY '))[0], 252, 'VRFY command'); diff --git a/t/plugin_tests.t b/t/plugin_tests.t index 69344c1..c514d4c 100644 --- a/t/plugin_tests.t +++ b/t/plugin_tests.t @@ -7,11 +7,8 @@ my $qp = Test::Qpsmtpd->new(); $qp->run_plugin_tests(); -foreach my $file ( - "./t/config/greylist.dbm", - "./t/config/greylist.dbm.lock" - ) { - next if ! -f $file; +foreach my $file ("./t/config/greylist.dbm", "./t/config/greylist.dbm.lock") { + next if !-f $file; unlink $file; -}; +} diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index 599a4af..0e5f88a 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -13,96 +13,96 @@ my $ao; $as = '<>'; $ao = Qpsmtpd::Address->parse($as); -ok ($ao, "parse $as"); -is ($ao->format, $as, "format $as"); +ok($ao, "parse $as"); +is($ao->format, $as, "format $as"); $as = ''; $ao = Qpsmtpd::Address->parse($as); -ok ($ao, "parse $as"); -is ($ao->format, $as, "format $as"); +ok($ao, "parse $as"); +is($ao->format, $as, "format $as"); $as = ''; $ao = Qpsmtpd::Address->parse($as); -ok ($ao, "parse $as"); -is ($ao->format, $as, "format $as"); +ok($ao, "parse $as"); +is($ao->format, $as, "format $as"); -is ($ao->user, 'foo', 'user'); -is ($ao->host, 'example.com', 'host'); +is($ao->user, 'foo', 'user'); +is($ao->host, 'example.com', 'host'); # the \ before the @ in the local part is not required, but -# allowed. For simplicity we add a backslash before all characters +# allowed. For simplicity we add a backslash before all characters # which are not allowed in a dot-string. $as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>'; $ao = Qpsmtpd::Address->parse($as); -ok ($ao, "parse $as"); -is ($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>', "format $as"); +ok($ao, "parse $as"); +is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>', + "format $as"); # email addresses with spaces $as = ''; $ao = Qpsmtpd::Address->parse($as); -ok ($ao, "parse $as"); -is ($ao->format, '<"foo\ bar"@example.com>', "format $as"); +ok($ao, "parse $as"); +is($ao->format, '<"foo\ bar"@example.com>', "format $as"); $as = 'foo@example.com'; $ao = Qpsmtpd::Address->new($as); -ok ($ao, "new $as"); -is ($ao->address, $as, "address $as"); +ok($ao, "new $as"); +is($ao->address, $as, "address $as"); $as = ''; $ao = Qpsmtpd::Address->new($as); -ok ($ao, "new $as"); -is ($ao->address, 'foo@example.com', "address $as"); +ok($ao, "new $as"); +is($ao->address, 'foo@example.com', "address $as"); $as = ''; $ao = Qpsmtpd::Address->new($as); -ok ($ao, "new $as"); -is ($ao->format, $as, "format $as"); +ok($ao, "new $as"); +is($ao->format, $as, "format $as"); $as = 'foo@foo.x.example.com'; -ok ($ao = Qpsmtpd::Address->parse('<'.$as.'>'), "parse $as"); -is ($ao && $ao->address, $as, "address $as"); +ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as"); +is($ao && $ao->address, $as, "address $as"); # Not sure why we can change the address like this, but we can so test it ... -is ($ao && $ao->address('test@example.com'), 'test@example.com', 'address(test@example.com)'); +is($ao && $ao->address('test@example.com'), + 'test@example.com', 'address(test@example.com)'); $as = ''; $ao = Qpsmtpd::Address->new($as); -ok ($ao, "new $as"); -is ($ao->format, $as, "format $as"); -is ("$ao", $as, "overloaded stringify $as"); +ok($ao, "new $as"); +is($ao->format, $as, "format $as"); +is("$ao", $as, "overloaded stringify $as"); $as = 'foo@foo.x.example.com'; -ok ($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>"); -is ($ao && $ao->address, $as, "address $as"); -ok ($ao eq $as, "overloaded 'cmp' operator"); +ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>"); +is($ao && $ao->address, $as, "address $as"); +ok($ao eq $as, "overloaded 'cmp' operator"); -my @unsorted_list = map { Qpsmtpd::Address->new($_) } - qw( - "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at - foo@example.com - ask@perl.org - foo@foo.x.example.com - jpeacock@cpan.org - test@example.com - ); +my @unsorted_list = map { Qpsmtpd::Address->new($_) } qw( + "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at + foo@example.com + ask@perl.org + foo@foo.x.example.com + jpeacock@cpan.org + test@example.com + ); # NOTE that this is sorted by _host_ not by _domain_ -my @sorted_list = map { Qpsmtpd::Address->new($_) } - qw( - jpeacock@cpan.org - foo@example.com - test@example.com - foo@foo.x.example.com - ask@perl.org - "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at - ); +my @sorted_list = map { Qpsmtpd::Address->new($_) } qw( + jpeacock@cpan.org + foo@example.com + test@example.com + foo@foo.x.example.com + ask@perl.org + "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at + ); my @test_list = sort @unsorted_list; -is_deeply( \@test_list, \@sorted_list, "sort via overloaded 'cmp' operator"); +is_deeply(\@test_list, \@sorted_list, "sort via overloaded 'cmp' operator"); # RT#38746 - non-RFC compliant address should return undef -$as=''; +$as = ''; $ao = Qpsmtpd::Address->new($as); -is ($ao, undef, "illegal $as"); +is($ao, undef, "illegal $as"); diff --git a/t/rset.t b/t/rset.t index ae1e462..d1c5ae9 100644 --- a/t/rset.t +++ b/t/rset.t @@ -7,7 +7,9 @@ use_ok('Test::Qpsmtpd'); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost'); -is(($smtpd->command('MAIL FROM:'))[0], 250, 'MAIL FROM:'); -is($smtpd->transaction->sender->address, 'ask@perl.org', 'got the right sender'); -is(($smtpd->command('RSET'))[0], 250, 'RSET'); -is($smtpd->transaction->sender, undef, 'No sender stored after rset'); +is(($smtpd->command('MAIL FROM:'))[0], + 250, 'MAIL FROM:'); +is($smtpd->transaction->sender->address, 'ask@perl.org', + 'got the right sender'); +is(($smtpd->command('RSET'))[0], 250, 'RSET'); +is($smtpd->transaction->sender, undef, 'No sender stored after rset'); diff --git a/t/tempstuff.t b/t/tempstuff.t index 467e5d7..fdcef05 100644 --- a/t/tempstuff.t +++ b/t/tempstuff.t @@ -5,7 +5,7 @@ use strict; use lib 't'; use_ok('Test::Qpsmtpd'); -BEGIN { # need this to happen before anything else +BEGIN { # need this to happen before anything else my $cwd = `pwd`; chomp($cwd); open my $spooldir, '>', "./config.sample/spool_dir"; @@ -15,13 +15,13 @@ BEGIN { # need this to happen before anything else ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); -my ($spool_dir,$tempfile,$tempdir) = ( $smtpd->spool_dir, -$smtpd->temp_file(), $smtpd->temp_dir() ); +my ($spool_dir, $tempfile, $tempdir) = + ($smtpd->spool_dir, $smtpd->temp_file(), $smtpd->temp_dir()); -ok( $spool_dir =~ m!t/tmp/$!, "Located the spool directory"); -ok( $tempfile =~ /^$spool_dir/, "Temporary filename" ); -ok( $tempdir =~ /^$spool_dir/, "Temporary directory" ); -ok( -d $tempdir, "And that directory exists" ); +ok($spool_dir =~ m!t/tmp/$!, "Located the spool directory"); +ok($tempfile =~ /^$spool_dir/, "Temporary filename"); +ok($tempdir =~ /^$spool_dir/, "Temporary directory"); +ok(-d $tempdir, "And that directory exists"); unlink "./config.sample/spool_dir"; rmtree($spool_dir); diff --git a/xt/01-syntax.t b/xt/01-syntax.t index c0ea682..3072713 100644 --- a/xt/01-syntax.t +++ b/xt/01-syntax.t @@ -4,38 +4,39 @@ use English qw/ -no_match_vars /; use File::Find; use Test::More; -if ( ! $ENV{'QPSMTPD_DEVELOPER'} ) { - plan skip_all => "not a developer, skipping POD tests"; -}; +if (!$ENV{'QPSMTPD_DEVELOPER'}) { + plan skip_all => "not a developer, skipping POD tests"; +} use lib 'lib'; my $this_perl = $Config{'perlpath'} || $EXECUTABLE_NAME; -my @files = find( {wanted=>\&test_syntax, no_chdir=>1}, 'plugins', 'lib', 't' ); +my @files = + find({wanted => \&test_syntax, no_chdir => 1}, 'plugins', 'lib', 't'); -sub test_syntax { +sub test_syntax { my $f = $File::Find::name; chomp $f; - return if ! -f $f; + return if !-f $f; return if $f =~ m/(~|\.(bak|orig|rej))/; my $r; eval { $r = `$this_perl -Ilib -MQpsmtpd::Constants -c $f 2>&1`; }; - my $exit_code = sprintf ("%d", $CHILD_ERROR >> 8); - if ( $exit_code == 0 ) { - ok( $exit_code == 0, "syntax $f"); - return; - }; - if ( $r =~ /^Can't locate (.*?) in / ) { - ok( 0 == 0, "skipping $f, I couldn't load w/o $1"); + my $exit_code = sprintf("%d", $CHILD_ERROR >> 8); + if ($exit_code == 0) { + ok($exit_code == 0, "syntax $f"); return; } - if ( $r =~ /^Base class package "Danga::Socket" is empty/ ) { - ok( 0 == 0, "skipping $f, Danga::Socket not available."); + if ($r =~ /^Can't locate (.*?) in /) { + ok(0 == 0, "skipping $f, I couldn't load w/o $1"); + return; + } + if ($r =~ /^Base class package "Danga::Socket" is empty/) { + ok(0 == 0, "skipping $f, Danga::Socket not available."); return; } print "ec: $exit_code, r: $r\n"; -}; +} done_testing(); diff --git a/xt/02-pod.t b/xt/02-pod.t index e989b93..67953f0 100644 --- a/xt/02-pod.t +++ b/xt/02-pod.t @@ -2,17 +2,17 @@ use Test::More; -if ( ! $ENV{'QPSMTPD_DEVELOPER'} ) { +if (!$ENV{'QPSMTPD_DEVELOPER'}) { plan skip_all => "not a developer, skipping POD tests"; exit; } eval "use Test::Pod 1.14"; -if ( $@ ) { +if ($@) { plan skip_all => "Test::Pod 1.14 required for testing POD"; exit; -}; +} my @poddirs = qw( lib plugins ); -all_pod_files_ok( all_pod_files( @poddirs ) ); +all_pod_files_ok(all_pod_files(@poddirs)); done_testing();