1#!/usr/bin/perl -w 2use strict; 3use warnings; 4use Test::More tests => 63; 5use MIME::Parser; 6 7 8# Are on a machine where binmode matters? 9my $txtmode = "./testout/textmode"; 10open TEXTMODE, ">$txtmode" or die "open textmode file!"; 11print TEXTMODE "abc\ndef\nghi\n"; 12close TEXTMODE; 13my $uses_crlf = ((-s $txtmode) == 12) ? 0 : 1; 14 15# Actual length of message: 16my $MSGLEN = 669; 17my $MSGLINES = 20; 18my $MSGLEN_text = $MSGLEN + ($uses_crlf * $MSGLINES); 19 20# Gout... 21sub gout { 22 my ($h, $ent) = @_; 23 my $test; 24 my $pos1; 25 my $pos2; 26 27 no strict 'refs'; 28 my $sh = (ref($h) ? $h : \*$h); 29 30 print $sh "\n", "=" x 30, " ", ($test = "ent->print"), "\n"; 31 $pos1 = tell($sh); 32 eval { $ent->print($h) }; 33 $pos2 = tell($sh); 34 ok((!$@ and (($pos2 - $pos1) == $MSGLEN_text)), 35 "$h, $test [$pos1-$pos2 == $MSGLEN_text]"); 36 37 print $sh "\n", "=" x 30, " ", ($test = "print ent->as_string"), "\n"; 38 $pos1 = tell($sh); 39 eval { print $h $ent->as_string }; 40 $pos2 = tell($sh); 41 ok((!$@ and (($pos2 - $pos1) == $MSGLEN_text)), 42 "$h, $test [$pos1-$pos2]"); 43 44 print $sh "\n", "=" x 30, " ", ($test = "ent->print_header"), "\n"; 45 eval { $ent->print_header($h) }; 46 ok(!$@, "$h, $test: $@"); 47 48 print $sh "\n", "=" x 30, " ", ($test = "ent->print_body"), "\n"; 49 eval { $ent->print_body($h) }; 50 ok(!$@, "$h, $test: $@"); 51 52 print $sh "\n", "=" x 30, " ", ($test = "ent->bodyhandle->print"), "\n"; 53 eval { $ent->bodyhandle->print($h) }; 54 ok(!$@, "$h, $test: $@"); 55 56 print $sh "\n", "=" x 30, " ",($test = "print ent->bodyhandle->data"),"\n"; 57 eval { print $h $ent->bodyhandle->data }; 58 ok(!$@, "$h, $test: $@"); 59 1; 60} 61 62 63# Loops: 64# When adjusting these, make sure to increment test count. Should be: 65# 21 * scalar @corelims * scalar @msgfiles 66my @msgfiles = qw(simple.msg); 67my @corelims = qw(ALL NONE 512); 68 69# Create a parser: 70my $parser = new MIME::Parser; 71$parser->output_dir("./testout"); 72 73# For each message: 74my $msgfile; 75foreach $msgfile (@msgfiles) { 76 77 my $corelim; 78 foreach $corelim (@corelims) { 79 80 # Set opt: 81 $parser->output_to_core($corelim); 82 83 # Parse: 84 my $ent = $parser->parse_open("./testin/$msgfile"); 85 my $out = "./testout/gauntlet.out"; 86 my $outsize = 3201 + ($uses_crlf * 97); 87 88 # Open output stream 1: 89 open GOUT, ">$out" or die "$!"; 90 gout('::GOUT', $ent); 91 close GOUT; 92 my $s1 = -s $out; 93 is($s1, $outsize, "BARE FH: size $out ($s1) == $outsize?"); 94 95 # Open output stream 2: 96 open GOUT, ">$out" or die "$!"; 97 gout(\*GOUT, $ent); 98 close GOUT; 99 my $s2 = -s $out; 100 is($s2, $outsize, "GLOB ref: size $out ($s2) == $outsize?"); 101 102 # Open output stream 3: 103 my $GOUT = IO::File->new($out, '>') || die "$!"; 104 gout($GOUT, $ent); 105 $GOUT->close; 106 my $s3 = -s $out; 107 is($s3, $outsize, "IO::File: size $out ($s3) == $outsize?"); 108 } 109} 110 1111; 112