#!/usr/local/bin/perl -w use MIME::Parser; use IO::File; use Email::MIME::Attachment::Stripper; use File::Slurp qw(write_file); my $output_path = 'C:\\phone\\'; my $word_to_delete = "deleteme"; my $movedir = 'completed'; use Cwd qw(); @files = <*.eml>; foreach $file (@files) { my $parser = MIME::Parser->new(); $parser->output_dir($output_path); $parser->output_prefix('deleteme'); $parser->output_to_core(0); $parser->extract_nested_messages(1); $parser->parse_nested_messages(1); open(INPUT, "$file") or die("Input error: $!"); local $/ = undef; my $textstuff = ; my $entity = $parser->parse_open($file) or die ("Input error: $!"); close (INPUT); my $pathx = Cwd::cwd(); my $header = $entity->head; $subject = $header->get('Subject'); $to = $header->get('To'); $from = $header->get('From'); $date = $header->get('Date'); $mime = $entity->mime_type; $effective = $entity->effective_type; print "[File]: $file...\n"; if ($from =~ "address" || $from =~ "address2" || $from =~ "address3" || $from =~ "address4" || $from =~ "address5" || $from =~ "address6" || $from =~ "address7") { if ($to =~ "address" || $to =~ "address2" || $to =~ "address3" || $to =~ "address4" || $to =~ "address5" || $to =~ "address6" || $to =~ "address7") { if ($textstuff =~ /sent from my ipod/ig || $textstuff =~ /sent from my iphone/ig) { print "Subject: $subject\nFrom: $from\nTo: $to\nDate: $date\nContent Type: content\nMime Type: $mime\nEffective Type: $effective\n"; open PART2, $file; while () { open (LOG, ">>C:\\phone\\MyStuff.txt"); $_ =~ s/Sent from my iPod//ig; $_ =~ s/Sent from my iPhone//ig; if ($entity->parts > 0) { print ">> Multi Part Message\n"; for (my $i=0;$i<$entity->parts;$i++) { my $subEntity = $entity->parts($i); print ">> MIME: ", $subEntity->mime_type," \n"; if ($subEntity->mime_type eq 'text/plain') { if (my $io = $subEntity->open("r")) { while (defined($_=$io->getline)) { $body2 = $_; $body2 =~ s/Sent from my iPod//ig; $body2 =~ s/Sent from my iPhone//ig; $body2 =~ s/\n//ig; $subject =~ s/\n//ig; print LOG "$subject

\n\n"; } } } } } else { my $body = join "", @{$entity->body}; print ">> Not a multipart\n"; print $body; $body =~ s/Sent from my iPod//ig; $body =~ s/Sent from my iPhone//ig; $body =~ s/\n//ig; $subject =~ s/\n//ig; print LOG "$subject

\n\n"; close (LOG); }} close PART2; }} my $m = Email::MIME::Attachment::Stripper->new($textstuff, \'force_filename' => 1); my $msg = $m->message; my @attachments = $m->attachments; foreach my $a(@attachments) { if ($a->{filename} ne "") { my $img = new IO::File "C:/phone/" . $a->{filename}, "w" or die "Can not create file! $!"; binmode $img; print $img $a->{payload}; print " -- Extracting -- : " . $a->{filename} . "..\n"; $entity->dump_skeleton; } } }if (!-d $movedir) { mkdir $movedir or die "Couldn't create $movedir - $!\n"; } if (-e $movedir) { print "Moving $pathx/$file to $pathx/$movedir/$file\n\n"; rename $pathx . "/" . $file, $pathx . "/" . $movedir . "/" . $file or die "Couldn't move $file to $movedir - $!\n"; } unlink (glob("$output_path/*$word_to_delete*")) or warn "can't delete files: $!"; $entity->dump_skeleton; } #### if ($textstuff =~ /sent from my ipod/ig || $textstuff =~ /sent from my iphone/ig || $from =~ /address3/ig) { #### if ($textstuff =~ /sent from my ipod/ig || $textstuff =~ /sent from my iphone/ig || $_ =~ /address3/ig) {