#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);
use utf8;
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";
plan tests => 7;
main: {
#-- Load MIME::Parser
use_ok("MIME::Parser");
#-- Prepare parser
my $parser = MIME::Parser->new();
$parser->output_to_core(1);
#-- Parse message file with attachment filename in Latin1
my $msgfile = "testmsgs/attachment-filename-encoding-Latin1.msg";
my $entity = parse_attachment_msg($parser, $msgfile);
#-- Check if parsed recommended filename is in UTF-8
my $filename = find_attachment_filename($entity);
is(utf8::is_utf8($filename), 1, "Parsed filename should have UTF-8 flag on");
#-- Check if parsed recommended filename matches the expected string
is($filename, "attachment.äöü",
"Parsed filename should match expectation");
#-- Parse message file with attachment filename in Latin1
$msgfile = "testmsgs/attachment-filename-encoding-UTF8.msg";
$entity = parse_attachment_msg($parser, $msgfile);
#-- Check if parsed recommended filename is in UTF-8
$filename = find_attachment_filename($entity);
is(utf8::is_utf8($filename), 1, "Parsed filename should have UTF-8 flag on");
#-- Check if parsed recommended filename matches the expected string
is($filename, "attachment.äöü",
"Parsed filename should match expectation");
# CPAN ticket #65162
# We need the default parser to tickle the bug
my $dir = tempdir(CLEANUP => 1);
$parser = MIME::Parser->new();
$parser->output_to_core(0);
$parser->output_under($dir);
$entity = $parser->parse_data("From: test\@example.com\nSubject: test\nDate: Tue, 25 Jan 2011 14:35:04 +0100\nMessage-Id: <123\@example.com>\nContent-Type: text/plain; name*=utf-8''%CE%B2CURE%2Etxt\n\ntest\n");
$filename = $entity->head->recommended_filename;
is(utf8::is_utf8($filename), 1, "Parsed filename should have UTF-8 flag on");
is($filename, "\x{3b2}CURE.txt", 'Got expected filename');
}
#-- Parse quoted printable file and return MIME::Entity
sub parse_attachment_msg {
my $parser = shift;
my $msgfile = shift;
open (my $fh, $msgfile)
or die "can't open $msgfile: $!";
my $entity = $parser->parse($fh);
close $fh;
return $entity;
}
sub find_attachment_filename {
my $entity = shift;
return '' unless $entity;
if ($entity->is_multipart) {
foreach my $subpart ($entity->parts) {
my $filename = find_attachment_filename($subpart);
return $filename if $filename;
}
} else {
my $head = $entity->head;
my $rfn = $head->recommended_filename;
return $rfn if $rfn;
}
return '';
}
1;