#!/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 = <This is test one. 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'); }