view release on metacpan or  search on metacpan

Miner/Attachment.pm  view on Meta::CPAN

    if ($content) {
        my $io;
        if ($io = $content->open("w")) {
           foreach (@body) { $io->print($_) }
           $io->close;
        }
    } else { 
        # Shit, no text at all
        $content =  MIME::Entity->build(
                Type        => "text/plain",
                Data        => \@body
        );
    }
    $entity->parts([$content]);
    $entity->make_singlepart;
    return $entity;
}

=head2 C<detach>

    detach($msgid)

This implements the front-end C<detach> option to C<mm>, the Mail::Miner 
command-line tool. It saves a message's attachments to the current
directory, interactively. 

=cut

sub detach {
    my $id = shift;
    my $obj = Mail::Miner::Attachment->fetch($id);

    die "Couldn't find that attachment!\n" unless $obj;

    my $first=0;
    my $filename = $a->filename ||
                   _gen_filename($a->contenttype);

    my $from = _namefrom(Mail::Address->parse($a->from_address));
    print "Detaching $filename (".$a->contenttype.") sent by $from...\n";
    
    if (-e $filename) {
        print "\n! $filename already exists. Replace? (y/N)\n";
        my $foo = <STDIN>;
        if ($foo !~ /^y/i) {
            print "OK, skipping...\n";
            next;
            }
        }
        open (OUT, ">", $filename) or do {warn "! $filename: $!\n"; next;};
        print OUT $a->attachment;
        close OUT;
}

sub _gen_filename {
    my $content_type = shift;
    # We're only using this for the generation of file names, so the
    # directory we feed it is irrelevant.
    my $filer = MIME::Parser::FileInto->new("/tmp");
    # This code borrowed from MIME::Parser::Filer
    my ($type, $subtype) = split m{/}, $content_type;
    $subtype ||= '';
    my $ext = ($filer->{MPF_Ext}{"$type/$subtype"} ||
               $filer->{MPF_Ext}{"$type/*"} ||
               $filer->{MPF_Ext}{"*/*"} ||
               ".dat");
    ++$GFileNo;
    return "attachment-$$-$GFileNo$ext";
}

sub _namefrom {
    my $what=shift;
    return unless $what;
    my ($address, $name, $phrase) = ($what->address, $what->name, $what->phrase);

    return  $name || $phrase || $address;
}

1;