The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 31;

use MIME::Tools;

use lib "./t";
use Globby;

use MIME::Parser;

# Set the counter, for filenames:
my $Counter = 0;

# Check and clear the output directory:
my $DIR = "./testout";
((-d $DIR) && (-w $DIR)) or die "no output directory $DIR";
unlink globby("$DIR/[a-z]*");


#------------------------------------------------------------
# BEGIN
#------------------------------------------------------------

my $parser;
my $entity;
my $msgno;
my $infile;
my $type;
my $enc;


#------------------------------------------------------------
package MyParser;
@MyParser::ISA = qw(MIME::Parser);
sub output_path {
    my ($parser, $head) = @_;

    # Get the recommended filename:
    my $filename = $head->recommended_filename;
    if (defined($filename) && $parser->evil_filename($filename)) {
##	diag("Parser.t: ignoring an evil recommended filename ($filename)");
	$filename = undef;      # forget it: it was evil
    }
    if (!defined($filename)) {  # either no name or an evil name
	++$Counter;
	$filename = "message-$Counter.dat";
    }

    # Get the output filename:
    my $outdir = $parser->output_dir;
    "$outdir/$filename";
}
package main;

#------------------------------------------------------------

$parser = new MyParser;
$parser->output_dir($DIR);

#------------------------------------------------------------
##diag("Read a nested multipart MIME message");
#------------------------------------------------------------
open IN, "./testmsgs/multi-nested.msg" or die "open: $!";
$entity = $parser->parse(\*IN);
ok($entity, "parse of nested multipart");

#------------------------------------------------------------
##diag("Check the various output files");
#------------------------------------------------------------
is(-s "$DIR/3d-vise.gif", 419, "vise gif size ok");
is(-s "$DIR/3d-eye.gif" , 357, "3d-eye gif size ok");
for $msgno (1..4) {
    ok(-s "$DIR/message-$msgno.dat", "message $msgno has a size");
}

#------------------------------------------------------------
##diag("Same message, but CRLF-terminated and no output path hook");
#------------------------------------------------------------
$parser = new MIME::Parser;
$parser->output_dir($DIR);
open IN, "./testmsgs/multi-nested2.msg" or die "open: $!";
$entity = $parser->parse(\*IN);
ok($entity, "parse of CRLF-terminated message");

#------------------------------------------------------------
##diag("Read a simple in-core MIME message, three ways");
#------------------------------------------------------------
my $data_scalar = <<EOF;
Content-type: text/html

<H1>This is test one.</H1>

EOF
my $data_scalarref = \$data_scalar;
my $data_arrayref  = [ map { "$_\n" } (split "\n", $data_scalar) ];

$parser->output_to_core('ALL');
foreach my $data_test ($data_scalar, $data_scalarref, $data_arrayref) {
    $entity = $parser->parse_data($data_test);
    isa_ok($entity, 'MIME::Entity');
    is($entity->head->mime_type, 'text/html', 'type is text/html');
}
$parser->output_to_core('NONE');


#------------------------------------------------------------
##diag("Simple message, in two parts");
#------------------------------------------------------------
$entity = $parser->parse_two("./testin/simple.msgh", "./testin/simple.msgb");
my $es = ($entity ? $entity->head->get('subject',0) : '');
like($es,  qr/^Request for Leave$/, "	parse of 2-part simple message (subj <$es>)");


# diag('new_tmpfile(), with real temp file');
{
	my $fh;
	eval {
		local $parser->{MP5_TmpToCore} = 0;
		$fh = $parser->new_tmpfile();
	};
	ok( ! $@, '->new_tmpfile() lives');
	ok( $fh->print("testing\n"), '->print on fh ok');

	ok( $fh->seek(0,0), '->seek on fh ok');
	my $line = <$fh>;
	is( $line, "testing\n", 'Read line back in OK');
}

# diag('new_tmpfile(), with in-core temp file');
{
	my $fh;
	eval {
		local $parser->{MP5_TmpToCore} = 1;
		$fh = $parser->new_tmpfile();
	};
	ok( ! $@, '->new_tmpfile() lives');
	ok( $fh->print("testing\n"), '->print on fh ok');

	ok( $fh->seek(0,0), '->seek on fh ok');
	my $line = <$fh>;
	is( $line, "testing\n", 'Read line back in OK');
}

# diag('new_tmpfile(), with temp files elsewhere');
{
	my $fh;
	eval {
		local $parser->{MP5_TmpDir} = $DIR;
		$fh = $parser->new_tmpfile();
	};
	ok( ! $@, '->new_tmpfile() lives');
	ok( $fh->print("testing\n"), '->print on fh ok');

	ok( $fh->seek(0,0), '->seek on fh ok');
	my $line = <$fh>;
	is( $line, "testing\n", 'Read line back in OK');
}

# diag('native_handle() on various things we might get');
{
	my $io_file_scalar = IO::File->new( do { my $foo = ''; \$foo }, '>:' );
	ok( MIME::Parser::Reader::native_handle( $io_file_scalar ), 'FH on scalar is OK');

	my $io_file_real   = IO::File->new_tmpfile();
	ok( MIME::Parser::Reader::native_handle( $io_file_real ), 'FH on real file is OK');

	my $globref   = \*STDOUT;
	ok( MIME::Parser::Reader::native_handle( $globref ), 'globref is OK');

}

# diag('tmp_recycling() exists again, as a no-op');
{
	my $rc = $parser->tmp_recycling(1);
	is( $rc, undef, 'tmp_recycling no-op method returned undef');
}