#!/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, rea
+ding 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) for
+mat 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, t
+hey 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_abbr
+ev);
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( <> ) );
    }
}