1
0
mirror of https://github.com/imapsync/imapsync.git synced 2024-11-18 00:32:34 +01:00
imapsync/W/paypal_reply/paypal_mimeexplode

188 lines
4.3 KiB
Plaintext
Raw Normal View History

2011-07-11 23:24:12 +02:00
#!/usr/bin/perl -w
# $Id: paypal_mimeexplode,v 1.1 2010/11/23 01:26:24 gilles Exp gilles $
=head1 NAME
mimeexplode - explode one or more MIME messages
=head1 SYNOPSIS
mimeexplode <mime-msg-file> <mime-msg-file> ...
someprocess | mimeexplode -
=head1 DESCRIPTION
Takes one or more files from the command line that contain MIME
messages, and explodes their contents out into subdirectories
of the current working directory. The subdirectories are
just called C<msg0>, C<msg1>, C<msg2>, etc. Existing directories are
skipped over.
The message information is output to the stdout, like this:
Message: msg3 (inputfile1.msg)
Part: msg3/filename-1.dat (text/plain)
Part: msg3/filename-2.dat (text/plain)
Message: msg5 (input-file2.msg)
Part: msg5/dir.gif (image/gif)
Part: msg5/face.jpg (image/jpeg)
Message: msg6 (infile3)
Part: msg6/filename-1.dat (text/plain)
This was written as an example of the MIME:: modules in the
MIME-parser package I wrote. It may prove useful as a quick-and-dirty
way of splitting a MIME message if you need to decode something, and
you don't have a MIME mail reader on hand.
=head1 COMMAND LINE OPTIONS
None yet.
=head1 AUTHOR
Eryq C<eryq@zeegee.com>, in a big hurry...
=cut
BEGIN { unshift @INC, ".." } # to test MIME:: stuff before installing it!
require 5.001;
use strict;
use Getopt::Long;
use vars qw($Msgno);
use MIME::Parser;
use Getopt::Std;
use File::Basename;
my $numopt = scalar(@ARGV);
my $help;
my $debug;
my $opt_ret = GetOptions(
"help" => \$help,
"debug!" => \$debug,
);
usage() and exit if ($help or ! $numopt) ;
sub usage {
print <<EOF;
Usage: $0 [options] email_1 email_2 ...
Options:
--help : print this message
--debug : verbose output
Example:
$0 email_1 email_2
EOF
}
#------------------------------------------------------------
# make_msg - make and return the name of a msgXXX directory
#------------------------------------------------------------
$Msgno = 1;
sub make_msg {
while (-d "msg$Msgno") {
++$Msgno;
die "self-imposed limit reached" if $Msgno == 256;
}
mkdir "msg$Msgno",0755 or die "couldn't make msg$Msgno: $!";
"msg$Msgno";
}
#------------------------------------------------------------
# make_msg_dir - make and return the name of a output directory
#------------------------------------------------------------
sub make_msg_dir {
my ($file) = @_;
if ("-" ne "$file") {
my $basefile = basename($file) . "_d";
-d $basefile and return($basefile);
mkdir $basefile or do {
warn "can not create directory $basefile: $!";
return undef;
};
return($basefile);
}else{
return(make_msg());
}
}
#------------------------------------------------------------
# dump_entity - dump an entity's file info
#------------------------------------------------------------
sub dump_entity {
my $ent = shift;
my @parts = $ent->parts;
if (@parts) { # multipart...
map { dump_entity($_) } @parts;
}
else { # single part...
$debug and print " Part: ", $ent->bodyhandle->path,
" (", scalar($ent->head->mime_type), ")\n";
}
}
#------------------------------------------------------------
# main
#------------------------------------------------------------
sub main {
my $file;
my $entity;
# Sanity:
(-w ".") or die "cwd not writable, you naughty boy...";
# Go through messages:
@ARGV or unshift @ARGV, "-";
while (defined($file = shift @ARGV)) {
my $msgdir = make_msg_dir($file);
next if not $msgdir;
$debug and print "Message: $msgdir ($file)\n";
# Create a new parser object:
my $parser = new MIME::Parser;
### $parser->parse_nested_messages('REPLACE');
# Optional: set up parameters that will affect how it extracts
# documents from the input stream:
$parser->output_dir($msgdir);
# Parse an input stream:
open FILE, $file or die "couldn't open $file";
$entity = $parser->read(\*FILE) or
print STDERR "Couldn't parse MIME in $file; continuing...\n";
close FILE;
# Congratulations: you now have a (possibly multipart) MIME entity!
dump_entity($entity) if $entity;
### $entity->dump_skeleton if $entity;
}
1;
}
exit (&main ? 0 : -1);
#------------------------------------------------------------
1;