Description: |
Does what it says on the tin. Reads from standard input or files/folders, so it is easy to use from your .procmailrc, from within your MUA, or the shell.
This was a joy to write – I have to thank to Simon Cozens and his cohorts for a bunch of great email modules.
Also, a practical application of Batch processing progress printer. |
#!/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( <> ) );
}
}
|