Extract attachment files from winmail.dat

winmail.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Convert::TNEF;
use File::Basename;
use File::Spec;
use File::Temp qw(tempdir);
use Encode;

my $file = $ARGV[0];
die "Usage: $0 <filename>\n" unless $file && -f $file;
my $dir = dirname($file);

my $tmp  = tempdir(CLEANUP => 1);
my $tnef = Convert::TNEF->read_in($file, { output_dir => $tmp })
    or die Convert::TNEF::errstr();

my @attachments = $tnef->attachments;

binmode STDOUT, ':utf8';
for my $att (@attachments) {

    my $filename = decode('Shift_JIS', $att->name);

    my $out = File::Spec->catfile($dir, $filename);
    if (-f $out) {
        print "File $out already exists. Overwrite? (y/n) [n]: ";
        chomp(my $ans = <STDIN>);
        next if lc($ans) ne 'y';
    }

    print "Writing to $out...\n";

    open my $fh, '>', $out or die "$out: $!";
    print $fh $att->data;
    close $fh;
}

$tnef->purge;