"Fossies" - the Fresh Open Source Software Archive

Member "Mail-SPF-Query-1.999.1/t/00_all.t" (9 Jan 2006, 4913 Bytes) of package /linux/privat/old/Mail-SPF-Query-1.999.1.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 # Before `make install' is performed this script should be runnable with
    2 # `make test'.  After `make install' it should work as `perl t/00all.t'.
    3 
    4 use warnings;
    5 use strict;
    6 
    7 use Test;
    8 use Getopt::Std;
    9 use IO::File;
   10 
   11 use constant TEST_FILENAME => 't/test.dat';
   12 
   13 my @test_table;
   14 
   15 BEGIN {
   16     my $test_file = IO::File->new(TEST_FILENAME);
   17     @test_table = grep { /\S/ && !/^\s*#/ } <$test_file>;
   18     chomp(@test_table);
   19     
   20     plan(
   21         tests   => 1 + map(/\G,?(\d+)/g, @test_table),
   22         todo    => [219]  # The SERVFAIL test isn't completely reliable.
   23     );
   24 };
   25 
   26 use Mail::SPF::Query;
   27 
   28 # Test #1: Did the library load okay?
   29 ok(1);
   30 
   31 my %opts;
   32 getopts('d:', \%opts);
   33 
   34 my $test_log;
   35 if ($opts{d}) {
   36     $test_log = IO::File->new(">$opts{d}") || die("Cannot open $opts{d} for output");
   37 }
   38 
   39 my $testnum = 2;
   40 
   41 foreach my $tuple (@test_table) {
   42     my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) =
   43         ($tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple));
   44     
   45     my ($actual_result, $actual_smtp_comment, $actual_header_comment);
   46     
   47     my ($sender, $localpolicy) = split(':', $domain, 2);
   48     $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
   49     $domain = $sender;
   50     if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ }
   51     
   52     my $testcnt = 3;
   53     
   54     if ($expected_result =~ /=(pass|fail),/) {
   55         my $debug_log_buf = "# Detailed debug log for test(s) $num:\n";
   56         Mail::SPF::Query->clear_cache;
   57         my $query = eval {
   58             Mail::SPF::Query->new(
   59                 ipv4    => $ipv4,
   60                 sender  => $sender,
   61                 helo    => $domain,
   62                 debug   => 1,
   63                 debuglog
   64                         => make_debug_log_accumulator(\$debug_log_buf),
   65                 local   => $localpolicy
   66             )
   67         };
   68         
   69         my $ok = 1;
   70         my $header_comment;
   71         
   72         $actual_result = '';
   73         
   74         foreach my $e_result (split(/,/, $expected_result)) {
   75             if ($e_result !~ /=/) {
   76                 my ($msg_result, $smtp_comment);
   77                 ($msg_result, $smtp_comment, $header_comment) = eval {
   78                     $query->message_result2()
   79                 };
   80                 
   81                 $actual_result .= $msg_result;
   82                 
   83                 $ok = ok($msg_result, $e_result) && $ok;
   84             }
   85             else {
   86                 my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);
   87                 my ($recip_result, $smtp_comment) = eval {
   88                     $query->result2(split(';', $recip))
   89                 };
   90                 
   91                 $actual_result .= "$recip=$recip_result,";
   92                 $testcnt++;
   93                 
   94                 $ok = ok($recip_result, $expected_recip_result) && $ok;
   95             }
   96         }
   97         
   98         $header_comment =~ s/\S+: //;  # strip the reporting hostname prefix
   99         
  100         if ($expected_header_comment) {
  101             $ok = ok($header_comment, $expected_header_comment) && $ok;
  102         }
  103         
  104         $actual_header_comment = $header_comment;
  105         $actual_smtp_comment = '.';
  106         
  107         STDERR->print($debug_log_buf) if !$ok;
  108     }
  109     else {
  110         my $debug_log_buf = "# Detailed debug log for test(s) $num:\n";
  111         my ($result, $smtp_comment, $header_comment) = eval {
  112             Mail::SPF::Query->new(
  113                 ipv4    => $ipv4,
  114                 sender  => $sender,
  115                 helo    => $domain,
  116                 local   => $localpolicy,
  117                 debug   => 1,
  118                 debuglog
  119                         => make_debug_log_accumulator(\$debug_log_buf),
  120                 default_explanation
  121                         => 'explanation'
  122             )->result()
  123         };
  124         
  125         $header_comment =~ s/^\S+: //;  # strip the reporting hostname prefix
  126         
  127         my $ok = ok($result,         $expected_result);
  128         if ($expected_smtp_comment) {
  129            $ok = ok($smtp_comment,   $expected_smtp_comment  ) && $ok;
  130            $ok = ok($header_comment, $expected_header_comment) && $ok;
  131         }
  132         
  133         $actual_result          = $result;
  134         $actual_smtp_comment    = $smtp_comment;
  135         $actual_header_comment  = $header_comment;
  136         
  137         STDERR->print($debug_log_buf) if !$ok;
  138     }
  139     
  140     if ($opts{d}) {
  141         $num = join(',', $testnum .. $testnum + $testcnt - 1);
  142         $testnum += $testcnt;
  143         $test_log->print(
  144             join(
  145                 "\t",
  146                 $num,
  147                 $sender . ($localpolicy ? ":$localpolicy": ''),
  148                 $ipv4,
  149                 $actual_result,
  150                 $actual_smtp_comment,
  151                 $actual_header_comment
  152             ),
  153             "\n"
  154         );
  155     }
  156 }
  157 
  158 sub make_debug_log_accumulator {
  159     my ($log_buffer_ref) = @_;
  160     return sub { $$log_buffer_ref .= "# $_[0]\n" };
  161 }
  162 
  163 # vim:syn=perl