]>
Commit | Line | Data |
---|---|---|
ef743ee6 DC |
1 | package PMG::MIMEUtils; |
2 | ||
3 | # provides helpers for dealing with MIME related code | |
4 | ||
5 | use strict; | |
6 | use warnings; | |
7 | ||
8 | use MIME::Parser; | |
9 | use File::Path; | |
10 | ||
11 | # wrapper around MIME::Parser::new which allows to give the config as hash | |
12 | sub new_mime_parser { | |
13 | my ($params, $dump_under) = @_; | |
14 | ||
15 | my $parser = new MIME::Parser; | |
16 | ||
17 | $parser->extract_nested_messages($params->{nested} // 0); | |
18 | $parser->ignore_errors($params->{ignore_errors} // 1); | |
19 | $parser->extract_uuencode($params->{extract_uuencode}) | |
20 | if defined($params->{extract_uuencode}); | |
21 | $parser->decode_bodies($params->{decode_bodies}) | |
22 | if defined($params->{decode_bodies}); | |
23 | $parser->max_parts($params->{maxfiles}) | |
24 | if defined($params->{maxfiles}); | |
25 | ||
26 | my $dumpdir = $params->{dumpdir}; | |
27 | if (!$dumpdir) { | |
28 | $parser->output_to_core(1); | |
29 | } elsif ($dump_under) { | |
30 | $parser->output_under($dumpdir); | |
31 | } else { | |
32 | rmtree $dumpdir; | |
33 | ||
34 | # Create and set the output directory: | |
35 | (-d $dumpdir || mkdir($dumpdir ,0755)) || | |
36 | die "can't create $dumpdir: $! : ERROR"; | |
37 | (-w $dumpdir) || | |
38 | die "can't write to directory $dumpdir: $! : ERROR"; | |
39 | ||
40 | $parser->output_dir($dumpdir); | |
41 | } | |
42 | ||
43 | # this has to be done after setting the dumpdir | |
44 | $parser->filer->ignore_filename($params->{ignore_filename}) | |
45 | if defined($params->{ignore_filename}); | |
46 | ||
47 | return $parser; | |
48 | } | |
49 | ||
50 | # bug fix for content/mimeparser.txt in regression test | |
51 | sub fixup_multipart { | |
52 | my ($entity) = @_; | |
53 | ||
54 | if ($entity->mime_type =~ m|multipart/|i && !$entity->head->multipart_boundary) { | |
55 | $entity->head->mime_attr('Content-type' => "application/x-unparseable-multipart"); | |
56 | } | |
57 | ||
58 | return $entity; | |
59 | } | |
60 | ||
61 | sub traverse_mime_parts { | |
62 | my ($entity, $subbefore, $subafter) = @_; | |
63 | ||
64 | if (defined($subbefore)) { | |
65 | $subbefore->($entity); | |
66 | } | |
67 | ||
68 | foreach my $part ($entity->parts) { | |
69 | traverse_mime_parts($part, $subbefore, $subafter); | |
70 | } | |
71 | ||
72 | if (defined($subafter)) { | |
73 | $subafter->($entity); | |
74 | } | |
75 | } | |
76 | ||
77 | 1; |