Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: Receiving an email attachment

by perldoc (Scribe)
on Jul 12, 2001 at 04:08 UTC ( #95893=note: print w/replies, xml ) Need Help??


in reply to Receiving an email attachment

#!/usr/bin/perl -w ###################################################################### +######## ## -*-perl-*- ## ## metamail - My slightly more secure metamail workalike. ## ## Courtesy of Gerard's Perl Page, ## http://www.geocities.com/gerardlanois/perl/ ## REVISION HISTORY ## ## version 1.0 2001/07/12 gerard@lanois.com - Initial release. ## version 1.1 2002/01/31 gerard@lanois.com - parts_DFS instead of r +ecursion ###################################################################### +######## use strict; use MIME::Parser; use File::Path; use File::Copy; use File::Basename; sub yesno($) { my $question = shift; print $question, " (y/n) [n]: "; my $key = <STDIN>; print "\n"; return $key =~ /^y/i; } my $tempdir = "metamail-tmp"; (-d $tempdir) or mkdir $tempdir,0755 or die "mkdir: $!"; (-w $tempdir) or die "can't write to directory"; my $parser = MIME::Parser->new; $parser->output_dir($tempdir); $parser->extract_uuencode(1); defined $ARGV[0] or die "usage: metamail filename\n"; my $entity = $parser->parse_open($ARGV[0]) or die "couldn't parse file "; my $head = MIME::Head->from_file($ARGV[0]); my @hdrs = qw( Subject Reply-to From ); foreach (@hdrs) { my $header = $head->get($_); if (defined $header) { chomp $header; print " $_:", $header, "\n"; } } $entity->dump_skeleton(\*STDOUT); print "-"x40, "\n"; foreach my $part ($entity->parts_DFS) { # Process only those entities which have bodies. next if (!$part->bodyhandle); # If there are evil chars in the bodyhandle path, then MIME::Parse +r # will choke and give a null file name, but the recommended # file name will always have the file name, evil characters # included. my $filename = $part->head->recommended_filename; if (!$filename) { $filename = $part->bodyhandle->path; } fileparse_set_fstype("MSWin32") if ($^O =~/MSWin32/); my ($file, $dir, $ext) = fileparse($filename, '\.[^.]*'); if (yesno("\n\n".$file.$ext." - want it?")) { if ((!-f "./".$file.$ext) || (-f "./".$file.$ext && (yesno("File exists, overwrite?"))) +) { move($part->bodyhandle->path, $file.$ext) ; print "Saved ", $file.$ext, "\n"; } } } $parser->filer->purge; rmtree $tempdir;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://95893]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2019-09-22 08:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The room is dark, and your next move is ...












    Results (273 votes). Check out past polls.

    Notices?