MARKOV / Mail-Box-3.011 / examples / strip-attachments.pl 

            

              
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

              
#!/usr/bin/perl
#
# $Id: strip-attachments.pl,v 1.4 2002/11/30 12:14:01 wrk Exp $
#
# Strip attachments using Mail::Box module.
#
# Usage:
#
#   perl strip-attachments.pl mbox
#
# This script reads a mailbox ($ARG1) and writes attachments larger than
# 16K to a folder (./attachments/). Next it deletes the attachment from
# the E-mail and writes it to a file named $ARG1.stripped.
#
# By Pjotr Prins <pjotr@pckassa.com>, $Date: 2002/11/30 12:14:01 $
#
# This code can be used and modified without restriction.
# Code based on example by Mark Overmeer, <mailbox@overmeer.net>, 9 nov 2001
# In this example, the stripped data is written to a different folder.
# You may not need that (but please be careful: test your script well!)
# Simply remove everything related to $outbox and $outfilename, and open
# the source folder with access => 'rw'
# You may want to have a look at Mail::Message::Convert::Rebuild, which
# the provides the $msg->rebuild() method.
# BE WARNED: when different messages specify the same filename for a part,
# they will overwrite another... you may want a message sequency number in
# the path of the output file.
use warnings;
use strict;
use lib '..', '.';
use Mail::Box::Manager;    # everything else will auto-compile when used
use File::Basename 'basename';
use File::Spec;
my $attachments = 'attachments';
#
# Get the command line arguments.
#
die "Usage: $0 folderfile\n"
    unless @ARGV==1;
my $filename = shift @ARGV;
#
# Create Attachments directory if non existent
#
   -d $attachments
or mkdir $attachments
or die "Cannot create directory $attachments\n";
#
# Open the folders
#
my $mgr    = Mail::Box::Manager->new;
my $folder = $mgr->open
   ( $filename
   , extract    => 'LAZY'   # never take the body unless needed
   );                       #  which saves memory and time.
die "Cannot open $filename: $!\n"
    unless defined $folder;
my $outfilename = "$filename.stripped";
# die "File $outfilename exists!" if -e $outfilename;
my $outbox = $mgr->open
  ( $outfilename
  , access   => 'a'        # append,
  , create   => 1          # create if not existent
  );
die "Cannot open $outfilename to write: $!\n"
    unless defined $outbox;
print "Mail folder $folder contains ", $folder->nrMessages, " messages:\n";
foreach my $message ($folder->messages)
{   printf "%3d. %s\n", $message->seqnr, $message->subject;
    $message->printStructure;
    my $m = $message->clone;
    unless($m->isMultipart)
    {   $outbox->addMessage($m);
        next;
    }
    foreach my $part ($m->parts)
    {
         # Strip attachments larger than 16K. Another example would be:
         #   next if $part->body->mimeType ne 'text/plain';
         next unless $part->body->size > 16384;
         print "\n**** Stripping Attachment "; # ,$part->head,"\n";
         # Warning: double names possible!  Put each message in seperate dir
         my $attachment = $part->body->dispositionFilename($attachments);
         print $attachment,"\n";
         unless(-f $attachment)     #  Write attachment to file
         {   open(FH, '>', $attachment)
                 or die "ERROR: cannot write attachment to $attachment: $!\n";
             $part->decoded->print(\*FH);
             close(FH)
                 or die "ERROR: writing to $attachment: $!\n";
         }
         $part->delete;
    }
    $outbox->addMessage($m);
}
$mgr->closeAllFolders;