Codebase list libemail-outlook-message-perl / upstream/0.920+git20201122.1.dd382f4
Import upstream version 0.920+git20201122.1.dd382f4 Debian Janitor 2 years ago
9 changed file(s) with 53 addition(s) and 36 deletion(s). Raw diff Collapse all Expand all
1717 'IO::String' => '0',
1818 'Pod::Usage' => '0',
1919 # Others - Versioned
20 'Email::MIME' => '1.949',
20 'Email::MIME' => '1.923',
2121 'Email::MIME::ContentType' => '1.014',
2222 'Email::Sender' => '1.3',
2323 'Email::Simple' => '2.206',
2222 "requires" : {
2323 "Carp" : "0",
2424 "Email::Address" : "0",
25 "Email::MIME" : "1.949",
25 "Email::MIME" : "1.923",
2626 "Email::MIME::ContentType" : "1.014",
2727 "Email::Sender" : "1.3",
2828 "Email::Simple" : "2.206",
6767 }
6868 },
6969 "version" : "0.920",
70 "x_serialization_backend" : "JSON::PP version 4.02"
70 "x_serialization_backend" : "JSON::PP version 4.04"
7171 }
2727 requires:
2828 Carp: '0'
2929 Email::Address: '0'
30 Email::MIME: '1.949'
30 Email::MIME: '1.923'
3131 Email::MIME::ContentType: '1.014'
3232 Email::Sender: '1.3'
3333 Email::Simple: '2.206'
22 use ExtUtils::MakeMaker;
33 WriteMakefile
44 (
5 'NAME' => 'Email::Outlook::Message',
6 'VERSION_FROM' => 'lib/Email/Outlook/Message.pm',
5 'INSTALLDIRS' => 'site',
76 'PREREQ_PM' => {
7 'Email::MIME::ContentType' => '1.014',
8 'File::Basename' => '0',
9 'Email::MIME' => '1.923',
10 'POSIX' => '0',
811 'Carp' => '0',
912 'Email::Address' => '0',
10 'Email::MIME' => '1.949',
11 'Email::MIME::ContentType' => '1.014',
13 'IO::All' => '0',
14 'Getopt::Long' => '0',
15 'Pod::Usage' => '0',
16 'Email::Simple' => '2.206',
17 'IO::String' => '0',
18 'Encode' => '0',
19 'Test::More' => '0',
1220 'Email::Sender' => '1.3',
13 'Email::Simple' => '2.206',
14 'Encode' => '0',
15 'File::Basename' => '0',
16 'Getopt::Long' => '0',
17 'IO::All' => '0',
18 'IO::String' => '0',
19 'OLE::Storage_Lite' => '0.14',
20 'POSIX' => '0',
21 'Pod::Usage' => '0',
22 'Test::More' => '0'
21 'OLE::Storage_Lite' => '0.14'
2322 },
24 'INSTALLDIRS' => 'site',
23 'VERSION_FROM' => 'lib/Email/Outlook/Message.pm',
24 'PL_FILES' => {},
25 'NAME' => 'Email::Outlook::Message',
2526 'EXE_FILES' => [
2627 'script/msgconvert'
27 ],
28 'PL_FILES' => {}
28 ]
2929 )
3030 ;
390390 my ($self, $key, $property) = @_;
391391 my ($encoding, $data) = @{$self->get_mapi_property($property)};
392392 $self->{$key} = $self->_decode_mapi_property($encoding, $data);
393 $self->{"${key}_ENCODING"} = $encoding;
393394
394395 $self->{VERBOSE}
395396 and $self->_log_property("Using ", $property, $key);
376376 return;
377377 }
378378
379 sub _body_plain_character_set {
380 my $self = shift;
381 my $body_encoding = $self->{BODY_PLAIN_ENCODING};
382 $self->_body_character_set($body_encoding)
383 }
384
385 sub _body_html_character_set {
386 my $self = shift;
387 my $body_encoding = $self->{BODY_HTML_ENCODING};
388 $self->_body_character_set($body_encoding)
389 }
390
379391 sub _body_character_set {
380392 my $self = shift;
381 return _codepage_to_charset($self->{CODEPAGE});
382 }
383
384 sub _codepage_to_charset {
385 my $codepage = shift;
386 if (defined $codepage) {
393 my $body_encoding = shift;
394 my $codepage = $self->{CODEPAGE};
395 if (defined $body_encoding && $body_encoding eq "001F") {
396 return "UTF-8";
397 } elsif (defined $codepage) {
387398 return $MAP_CODEPAGE->{$codepage} || "CP$codepage";
388 }
389 return 'CP1252';
399 } else {
400 return 'CP1252';
401 }
390402 }
391403
392404 sub _create_mime_plain_body {
393405 my $self = shift;
394 my $charset = $self->_body_character_set;
406 my $charset = $self->_body_plain_character_set;
395407 my $body_str = $self->{BODY_PLAIN};
396408 if ($charset ne "UTF-8") {
397409 # In this case, the body is a string of octets and needs to be decoded.
413425 return Email::MIME->create(
414426 attributes => {
415427 content_type => "text/html",
416 charset => $self->_body_character_set,
428 charset => $self->_body_html_character_set,
417429 disposition => "inline",
418430 encoding => "8bit",
419431 },
1919
2020 my $text = $parts[0];
2121 like($text->content_type, qr{^text/plain}, "Content type should be multipart/alternative");
22 like($text->content_type, qr{; charset=CP1252}, "charset should be CP1252");
22 like($text->content_type, qr{; charset="?CP1252"?}, "charset should be CP1252");
2323 is($text->header("Content-Disposition"), "inline", "Testing content disposition");
2424 is($text->body, "This email contains an email\x85 Email-ception!!!\n\n", "Testing body");
2525 is(scalar($text->subparts), 0, "No sub-parts");
2626 my $html = $parts[1];
2727 like($html->content_type, qr{^text/html}, "Content type should be text/html");
28 like($text->content_type, qr{; charset=CP1252}, "charset should be CP1252");
28 like($text->content_type, qr{; charset="?CP1252"?}, "charset should be CP1252");
2929 is($html->header("Content-Disposition"), "inline", "Testing content disposition");
3030 is(scalar($html->subparts), 0, "No sub-parts");
5757 sub test_to_email_mime_with_plain_part {
5858 my $p = shift;
5959 $p->{BODY_PLAIN} = "plain";
60 $p->{BODY_PLAIN_ENCODING} = "001E";
6061 $p->{BODY_HTML} = undef;
6162 my $m = $p->to_email_mime;
6263 ok(defined $m);
6364 ok(($m->parts) == 1);
6465 is($m->body, "plain");
65 is($m->content_type, "text/plain; charset=CP1252");
66 like($m->content_type, qr{^text/plain; charset="?CP1252"?$});
6667 }
6768
6869 sub test_to_email_mime_with_html_part {
6970 my $p = shift;
7071 $p->{BODY_PLAIN} = undef;
7172 $p->{BODY_HTML} = "html";
73 $p->{BODY_HTML_ENCODING} = "001E";
7274 my $m = $p->to_email_mime;
7375 ok(defined $m);
7476 ok(($m->parts) == 1);
7577 is($m->body, "html");
76 is($m->content_type, "text/html; charset=CP1252");
78 like($m->content_type, qr{^text/html; charset="?CP1252"?$});
7779 }
7880
7981 sub test_to_email_mime_with_two_parts {
8082 my $p = shift;
8183 $p->{BODY_PLAIN} = "plain";
84 $p->{BODY_PLAIN_ENCODING} = "001E";
8285 $p->{BODY_HTML} = "html";
86 $p->{BODY_HTML_ENCODING} = "001E";
8387 my $m = $p->to_email_mime;
8488 ok(defined $m);
8589 ok(($m->parts) == 2);
3434
3535 my $jpg = $parts[1];
3636 like($jpg->content_type, qr{^image/jpeg}, "Content type should be image/jpeg");
37 is($jpg->header("Content-Disposition"), "attachment; filename=test.jpg", "Testing content disposition");
37 like($jpg->header("Content-Disposition"), qr{^attachment; filename="?test.jpg"?$}, "Testing content disposition");
3838 is(scalar($jpg->subparts), 0, "No sub-parts");
3939 is(length($jpg->body), 7681, "Correct jpeg size");