#!/usr/bin/perl
use strict;
use warnings;
no warnings 'once';

=head1 NAME

attachments -- mass-dumps file attachments from mail

=head1 SYNOPSIS

F<attachments>
S<B<[ -f ]>>
S<B<[ -d directory ]>>
S<B<[ src [ src .. ] ]>>

=head1 DESCRIPTION

This program saves files attached to any number of email messages, reading either individual messages of entire mailboxes. If no arguments are passed, it expects the data on standard input.

=head1 ARGUMENTS

=over 4

=item B<-h>, B<--help>

See a synopsis.

=item B<--man>

Browse the manpage.

=item B<-f>, B<--folders>

Puts the program in folders mode. Any arguments passed are assumed to be mailboxes of any of a number of formats. Otherwise, an mbox(5) format mailbox is expected on standard input.

=back

=over 4

=head1 OPTIONS

=item B<-d>, B<--directory>

If given, attachments will be saved under this directory. Otherwise, they go in the current directory.

=over 4

=back

=head1 AUTHORS

Aristotle Pagaltzis

=head1 COPYRIGHT

This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

use Pod::Usage;
use Getopt::Long 2.24, qw(:config bundling no_ignore_case no_auto_abbrev);
use Email::MIME;
use Fcntl;
use File::Basename;
use File::Spec::Functions qw( canonpath catfile );

package Email::MIMEFolder;

our @ISA = qw( Email::Folder );

sub bless_message {
	my $self = shift;
	my ( $msg ) = @_;
	Email::MIME->new( $msg );
}

package main;

use constant BLOCKSIZE => 2**16;

sub write_file {
	my ( $fn, $content ) = @_;
	my $offs = 0;
	my $count = BLOCKSIZE;

	sysopen my $fh, $fn, O_WRONLY | O_EXCL | O_CREAT
		or die "Couldn't open $fn for writing: $!\n";

	$offs += $count = syswrite $fh, substr $$content, $offs, $count
		until $count < BLOCKSIZE;

	close $fh
		or die "Error closing $fn: $!\n"
}

sub read_file {
	my ( $fn ) = @_;
	open my $fh, '<', $fn
		or die "Couldn't open $fn for reading: $!\n";
	local $/;
	<$fh>;
}

sub make_printer {
	my $hdr = shift;
	my $count;
	return bless sub {
		my $item = shift || do {
			print "\n" if $count;
			return;
		};
		print( ( $count ? "," : "$hdr:") , " ", $item );
		++$count;
	}, 'PRINTER';
	sub PRINTER::DESTROY { shift->() }
}

my $opt_directory;

sub process_mail {
	my ( $msg ) = @_;
	my $print = make_printer( $msg->header( "Message-ID" ) );
	for( $msg->parts ) {
		my $fn = $_->filename;
		next if not defined $fn;
		$fn = basename $fn;
		next if not length $fn;
		$print->( $fn );
		my $path = canonpath catfile $opt_directory, $fn;
		write_file $path, \( $_->body );
	}
}

GetOptions(
	'h|help'        => sub { pod2usage( -verbose => 1 ) },
	'man'           => sub { pod2usage( -verbose => 2 ) },
	'f|folders'     => \( my $opt_folders ),
	'd|directory=s' => \(    $opt_directory = '.' ),
) or pod2usage();

if( $opt_folders ) {
	require Email::Folder;

	my $msg;
	if( @ARGV ) {
		for( @ARGV ) {
			my $folder = Email::MIMEFolder->new( $_ );
			process_mail( $msg ) while $msg = $folder->next_message;
		}
	}
	else {
		# HACK, because ::Mbox sucks
		my $folder = Email::MIMEFolder->new( 'stdin', reader => 'Email::Folder::Mbox' );
		open $folder->reader->{_fh}, '<', \do { local $/; <> };

		process_mail( $msg ) while $msg = $folder->next_message;
	}
}
else {
	if( @ARGV ) {
		process_mail( Email::MIME->new( read_file $_ ) ) for @ARGV;
	}
	else {
		local $/;
		process_mail( Email::MIME->new( <> ) );
	}
}