File: Misc.t

package info (click to toggle)
libmime-tools-perl 5.515-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,612 kB
  • sloc: perl: 6,349; makefile: 8
file content (138 lines) | stat: -rw-r--r-- 4,168 bytes parent folder | download | duplicates (10)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 14;

use MIME::Head;
use MIME::Parser;
use Mail::Field;
use MIME::Head;
use MIME::Decoder::QuotedPrint;

#------------------------------
# Bug 971008 from Michael W. Normandin <michael.normandin@csfb.com>:
#------------------------------
# I've found something you may be interested in :
# Header: 
#        Content-Type: application/vnd.ms-powerpoint; name="June97V4.0.ppt"
# Code:
#        $mtype = $pentity->head->mime_type;
#        print "$mytype\n";
#
# Produces:  
#        application/vnd
#
{
    my $head = MIME::Head->new([
	 'Content-Type: application/vnd.ms-powerpoint; name="June97V4.0.ppt"'
				]);
    is($head->mime_type,
	      "application/vnd.ms-powerpoint",
	      "bug 971008-MWN: are MIME attributes parsed ok?");
}

#------------------------------
# Bug 970822 from Anselm Lingnau <lingnau@tm.informatik.uni-frankfurt.de>
#------------------------------
#   use Mail::Field;
#   use MIME::Head;
#   $field = Mail::Field->new('Content-type', 'text/HTML; charset="US-ASCII"');
#   print $field->type, "\n";
# 
# but all I see is:
#
#   Can't locate object method "parse" via package "Mail::Field::ContType"
#   at /local/pkg/perl/5.004/lib/site_perl/Mail/Field.pm line 306.
# 
# I suppose this has to do with the fact that it is `MIME::Field' rather
# than `Mail::Field', but I am at a loss as to what to do next. Maybe you
# can help? Thank you very much.
{
    my $field = Mail::Field->new('Content-type', 
				 'text/HTML; charset="US-ASCII"');
    is($field->paramstr('_'),
	      "text/HTML",
	      "bug 970822-AL: Mail::Field register problem (paramstr)");
    is($field->type,
	      "text/html",
	      "bug 970822-AL: Mail::Field register problem (type)");
}

#------------------------------
# Bug 970725 from Denis N. Antonioli <antonio@ifi.unizh.ch>
#------------------------------
# Were it possible to incorporate the guideline #8 from RFC 2049?
# The change involved is minim: just adding the 2 lines
#    $res =~ s/\./=2E/go;
#    $res =~ s/From /=46rom /go;
# at the start of encode_qp_really in MIME::Decoder::QuotedPrint?
#
# Textual mode.
{
    my $pair;
    foreach $pair (["From me",   "=46rom me=\n"],
		   [".",         ".=\n"],  # soft line-break
		   [".\n",       "=2E\n"], # line-break
		   [" From you", " From you=\n"]) {
	my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 1);
	is($out, $pair->[1],
		  "bug 970725-DNA: QP use of RFC2049 guideline 8");
    }
}
# Binary mode
{
    my $pair;
    foreach $pair (["From me",   "=46rom me=\n"],
		   [".",         ".=\n"],     # soft line-break
		   [".\n",       ".=0A=\n"],  # line-break
		   [" From you", " From you=\n"]) {
	my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 0);
	is($out, $pair->[1],
		  "bug 970725-DNA: QP use of RFC2049 guideline 8");
    }
}

#------------------------------
# Bug 970626 from Sun, Tong <TSun@FS.com>
#------------------------------
# @history = $head->get_all('Received');
#
# The above code does not work. It confused me at the beginning. Then, I
# found out it is only a spelling error: when I changed the 'Received' to
# 'received', it works ( you know why ).
{
    my $head = MIME::Head->new(["Received: first\n",
				"Received: second\n",
				"received: third\n",
				"Received: fourth\n",
				"subject: hi!\n"]);
    my @received = $head->get_all('Received');
    is(scalar @received, 
		 4,	 
		 "bug 970626-TS: header get_all() case problem fixed?");
}

#------------------------------
# Bug 980430 from Jason L Tibbitts III <tibbs@hpc.uh.edu>
#------------------------------
# Boundary-parsing errors for this message.
{
    my $parser = new MIME::Parser;
    $parser->output_to_core('ALL');
    my $e = eval { $parser->parse_open("testin/jt-0498.msg") };
    is(scalar $e->parts, 
		 2,
		 "bug 980430-JT: did we get 2 parts?");
}

# Bug reported by Marcel Brouillet.  MT 5.416 would parse as a single part.
{
    my $parser = new MIME::Parser;
    $parser->output_to_core('ALL');
    my $e = eval { $parser->parse_open("testin/twopart.msg") };
    is( scalar $e->parts, 
		 2,
		 "bug: did we get 2 parts?");
}

1;