Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
scripts	[ DIR ]	drwxr-xr-x
build.pl	1.77 KB	-rw-r--r--
grep.pl	936 B	-rw-r--r--
multipart.pl	1.38 KB	-rw-r--r--
open.pl	1.02 KB	-rw-r--r--
reply.pl	2.82 KB	-rw-r--r--
send.pl	1.05 KB	-rw-r--r--
smaller.pl	2.26 KB	-rw-r--r--
strip-attachments.pl	3.33 KB	-rw-r--r--
strip-spam-markup.pl	6.75 KB	-rw-r--r--
takelarge.pl	1.64 KB	-rw-r--r--
unpack.pl	2.03 KB	-rw-r--r--

Code Editor : unpack.pl

#!/usr/bin/perl
#
# Read a message from stdin, for instance from a '.forward' file
#       | unpack.pl
# The files get unpacked.

# This code can be used and modified without restriction.
# Mark Overmeer, <mailbox@overmeer.net>, 29 jan 2010

use warnings;
use strict;

use Errno  'EEXIST';
use POSIX  'strftime';

use Mail::Message  ();
use MIME::Types    ();

### configure this:
my $workdir = '/tmp/incoming';

# create the common work directory
-d $workdir
    or mkdir $workdir
    or die "cannot create unpack directory $workdir: $!\n";

# Create a unique unpack directory for this message
# More than one message can arrive in a second, even in parallel
my $unpackdir;
my $now = strftime "%Y%m%d-%T", localtime;

UNIQUE:
for(my $unique = 1; ; $unique++ )
{   $unpackdir = "$workdir/$now-$unique";
    mkdir $unpackdir and last;
    $!==EEXIST
        or die "cannot create unpack directory $unpackdir: $!";
}

# Read the message from STDIN
my $from_line = <>;    # usually added by the local MTA
my $msg = Mail::Message->read(\*STDIN);

# Shows message structure
# $msg->printStructure;

my $mime_types = MIME::Types->new;
my $partnr     = '00';

foreach my $part ($msg->parts('RECURSE'))
{   my $body     = $part->decoded;
    my $type     = $mime_types->type($body->mimeType);

# some message parts will contain a filename
    my $dispfn   = $body->dispositionFilename || '';
    my $partname = $partnr++ . (length $dispfn ? ".$dispfn" : '');

# try to find a nice filename extension if not yet known
    unless($partname =~ /\.\w{3,5}$/)
    {   my $ext    = $type ? ($type->extensions)[0] : undef;
        $partname .= ".$ext" if $ext;
    }

my $filename  = "$unpackdir/$partname";
#print "$filename\n";

if($type->isBinary)
    {   open OUT, '>:raw', $filename
           or die "cannot create binary part file $filename: $!";
    }
    else
    {   open OUT, '>:encoding(utf-8)', $filename
           or die "cannot create text part file $filename: $!";
    }

$body->print(\*OUT);
    close OUT
        or warn "write errors to $filename: $!";
}

${this.title}

Code Editor : unpack.pl