#!/usr/bin/perl -w

# mimeexplode - explode one or more MIME messages
# Eryq, eryq@zeegee.com
# https://kinzler.com/me/home.html#other
# from MIME-tools-5.306 in Perl CPAN

# hacked make_msg to use ./BASE.d{,1-} for the explode directory, not ./msg{0-}
# added "not file" check
# kinzler, 2 Aug 2000
# hacked dump_entity to make "cid-#" hard links to parts with Content-ID's
# kinzler, 5 Oct 2005
# hacked dump_entity to hard link text/calendar foo.txt's to foo.ics's
# kinzler, 21 Jul 2009

=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 
named after the filename part of the file arguments, or C<stdin>,
with C<.d> and digits appended as needed.  Existing directories are
skipped over.

The message information is output to the stdout, like this:

    Message: inputfile1.msg.d (inputfile1.msg)
        Part: inputfile1.msg.d/filename-1.dat (text/plain)
        Part: inputfile1.msg.d/filename-2.dat (text/plain)
    Message: input-file2.msg.d (input-file2.msg)
        Part: input-file2.msg.d/dir.gif (image/gif)
        Part: input-file2.msg.d/face.jpg (image/jpeg)
    Message: infile3.d (infile3)
        Part: infile3.d/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...
Steve Kinzler C<steve@kinzler.com>, personal hacks

=cut

#BEGIN { unshift @INC, ".." }    # to test MIME:: stuff before installing it!

require 5.001;

use strict;
#use vars qw($Msgno);

use MIME::Parser;
#use Getopt::Std;

#------------------------------------------------------------
# make_msg - make and return the name of a msgXXX directory
#------------------------------------------------------------
#$Msgno = 0;

sub make_msg {
    my $base = shift;
    $base = 'stdin' if $base eq '' || $base eq '-';
    $base =~ s/.*\///;
    $base .= '.d';
    my $dir = $base;
    my $Msgno = 0;
    while (-d $dir) { 
	++$Msgno;
	die "self-imposed limit reached" if $Msgno == 256;
	$dir = "$base$Msgno";
    }
    mkdir $dir,0755 or die "couldn't make $dir: $!";
    $dir;
}

#------------------------------------------------------------
# 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...
	my $path = $ent->bodyhandle->path;
	my $type = $ent->head->mime_type;
	print "    Part: $path ($type)\n";
	if (my $cid = $ent->head->get('Content-ID')) {
	    $cid =~ s/^\s*<?//; $cid =~ s/>?\s*$//;
	    link($path, "cid-$cid");
	}
	link($path, substr($path, 0, length($path) - 4) . '.ics')
	    if $type eq 'text/calendar' and $path =~ /\.txt$/;
    }
}

#------------------------------------------------------------
# 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)) {
	-f $file or
	    print(STDERR "$file isn't a file, continuing...\n"), next;

	my $msgdir = make_msg($file);
	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;