← Back to branch summary

~ubuntu-branches/ubuntu/utopic/libmime-tools-perl/utopic

« back to all changes in this revision

Viewing changes to t/Parser.t

  • Committer: Bazaar Package Importer
  • Author(s): gregor herrmann
  • Date: 2010-06-12 21:32:48 UTC
  • Revision ID: james.westby@ubuntu.com-20100612213248-u0okbx1f26wpqu32
Tags: upstream-5.428
Import upstream version 5.428

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/Parser.t
 
1
#!/usr/bin/perl -w
 
2
use strict;
 
3
use warnings;
 
4
use Test::More tests => 31;
 
5
 
 
6
use MIME::Tools;
 
7
 
 
8
use lib "./t";
 
9
use Globby;
 
10
 
 
11
use MIME::Parser;
 
12
 
 
13
# Set the counter, for filenames:
 
14
my $Counter = 0;
 
15
 
 
16
# Check and clear the output directory:
 
17
my $DIR = "./testout";
 
18
((-d $DIR) && (-w $DIR)) or die "no output directory $DIR";
 
19
unlink globby("$DIR/[a-z]*");
 
20
 
 
21
 
 
22
#------------------------------------------------------------
 
23
# BEGIN
 
24
#------------------------------------------------------------
 
25
 
 
26
my $parser;
 
27
my $entity;
 
28
my $msgno;
 
29
my $infile;
 
30
my $type;
 
31
my $enc;
 
32
 
 
33
 
 
34
#------------------------------------------------------------
 
35
package MyParser;
 
36
@MyParser::ISA = qw(MIME::Parser);
 
37
sub output_path {
 
38
    my ($parser, $head) = @_;
 
39
 
 
40
    # Get the recommended filename:
 
41
    my $filename = $head->recommended_filename;
 
42
    if (defined($filename) && $parser->evil_filename($filename)) {
 
43
##      diag("Parser.t: ignoring an evil recommended filename ($filename)");
 
44
        $filename = undef;      # forget it: it was evil
 
45
    }
 
46
    if (!defined($filename)) {  # either no name or an evil name
 
47
        ++$Counter;
 
48
        $filename = "message-$Counter.dat";
 
49
    }
 
50
 
 
51
    # Get the output filename:
 
52
    my $outdir = $parser->output_dir;
 
53
    "$outdir/$filename";
 
54
}
 
55
package main;
 
56
 
 
57
#------------------------------------------------------------
 
58
 
 
59
$parser = new MyParser;
 
60
$parser->output_dir($DIR);
 
61
 
 
62
#------------------------------------------------------------
 
63
##diag("Read a nested multipart MIME message");
 
64
#------------------------------------------------------------
 
65
open IN, "./testmsgs/multi-nested.msg" or die "open: $!";
 
66
$entity = $parser->parse(\*IN);
 
67
ok($entity, "parse of nested multipart");
 
68
 
 
69
#------------------------------------------------------------
 
70
##diag("Check the various output files");
 
71
#------------------------------------------------------------
 
72
is(-s "$DIR/3d-vise.gif", 419, "vise gif size ok");
 
73
is(-s "$DIR/3d-eye.gif" , 357, "3d-eye gif size ok");
 
74
for $msgno (1..4) {
 
75
    ok(-s "$DIR/message-$msgno.dat", "message $msgno has a size");
 
76
}
 
77
 
 
78
#------------------------------------------------------------
 
79
##diag("Same message, but CRLF-terminated and no output path hook");
 
80
#------------------------------------------------------------
 
81
$parser = new MIME::Parser;
 
82
$parser->output_dir($DIR);
 
83
open IN, "./testmsgs/multi-nested2.msg" or die "open: $!";
 
84
$entity = $parser->parse(\*IN);
 
85
ok($entity, "parse of CRLF-terminated message");
 
86
 
 
87
#------------------------------------------------------------
 
88
##diag("Read a simple in-core MIME message, three ways");
 
89
#------------------------------------------------------------
 
90
my $data_scalar = <<EOF;
 
91
Content-type: text/html
 
92
 
 
93
<H1>This is test one.</H1>
 
94
 
 
95
EOF
 
96
my $data_scalarref = \$data_scalar;
 
97
my $data_arrayref  = [ map { "$_\n" } (split "\n", $data_scalar) ];
 
98
 
 
99
$parser->output_to_core('ALL');
 
100
foreach my $data_test ($data_scalar, $data_scalarref, $data_arrayref) {
 
101
    $entity = $parser->parse_data($data_test);
 
102
    isa_ok($entity, 'MIME::Entity');
 
103
    is($entity->head->mime_type, 'text/html', 'type is text/html');
 
104
}
 
105
$parser->output_to_core('NONE');
 
106
 
 
107
 
 
108
#------------------------------------------------------------
 
109
##diag("Simple message, in two parts");
 
110
#------------------------------------------------------------
 
111
$entity = $parser->parse_two("./testin/simple.msgh", "./testin/simple.msgb");
 
112
my $es = ($entity ? $entity->head->get('subject',0) : '');
 
113
like($es,  qr/^Request for Leave$/, "   parse of 2-part simple message (subj <$es>)");
 
114
 
 
115
 
 
116
# diag('new_tmpfile(), with real temp file');
 
117
{
 
118
        my $fh;
 
119
        eval {
 
120
                local $parser->{MP5_TmpToCore} = 0;
 
121
                $fh = $parser->new_tmpfile();
 
122
        };
 
123
        ok( ! $@, '->new_tmpfile() lives');
 
124
        ok( $fh->print("testing\n"), '->print on fh ok');
 
125
 
 
126
        ok( $fh->seek(0,0), '->seek on fh ok');
 
127
        my $line = <$fh>;
 
128
        is( $line, "testing\n", 'Read line back in OK');
 
129
}
 
130
 
 
131
# diag('new_tmpfile(), with in-core temp file');
 
132
{
 
133
        my $fh;
 
134
        eval {
 
135
                local $parser->{MP5_TmpToCore} = 1;
 
136
                $fh = $parser->new_tmpfile();
 
137
        };
 
138
        ok( ! $@, '->new_tmpfile() lives');
 
139
        ok( $fh->print("testing\n"), '->print on fh ok');
 
140
 
 
141
        ok( $fh->seek(0,0), '->seek on fh ok');
 
142
        my $line = <$fh>;
 
143
        is( $line, "testing\n", 'Read line back in OK');
 
144
}
 
145
 
 
146
# diag('new_tmpfile(), with temp files elsewhere');
 
147
{
 
148
        my $fh;
 
149
        eval {
 
150
                local $parser->{MP5_TmpDir} = $DIR;
 
151
                $fh = $parser->new_tmpfile();
 
152
        };
 
153
        ok( ! $@, '->new_tmpfile() lives');
 
154
        ok( $fh->print("testing\n"), '->print on fh ok');
 
155
 
 
156
        ok( $fh->seek(0,0), '->seek on fh ok');
 
157
        my $line = <$fh>;
 
158
        is( $line, "testing\n", 'Read line back in OK');
 
159
}
 
160
 
 
161
# diag('native_handle() on various things we might get');
 
162
{
 
163
        my $io_file_scalar = IO::File->new( do { my $foo = ''; \$foo }, '>:' );
 
164
        ok( MIME::Parser::Reader::native_handle( $io_file_scalar ), 'FH on scalar is OK');
 
165
 
 
166
        my $io_file_real   = IO::File->new_tmpfile();
 
167
        ok( MIME::Parser::Reader::native_handle( $io_file_real ), 'FH on real file is OK');
 
168
 
 
169
        my $globref   = \*STDOUT;
 
170
        ok( MIME::Parser::Reader::native_handle( $globref ), 'globref is OK');
 
171
 
 
172
}
 
173
 
 
174
# diag('tmp_recycling() exists again, as a no-op');
 
175
{
 
176
        my $rc = $parser->tmp_recycling(1);
 
177
        is( $rc, undef, 'tmp_recycling no-op method returned undef');
 
178
}