gnats-mime updated

[Rado S <rado@xxxxxxxxxxxxxxxxxxx>]

Well, it was the 1st shot anyway. With more test cases, here an
update with prettier clone names and no empty 'dummy' files for
trailing empty lines.

It's just a dirty hack, so even though an interactive dialog might
be nice, for casual piping it's sufficient without. Feel free to
hack it further.

-- 
© Rado S. -- You must provide YOUR effort for your goal!
Even if it seems insignificant, in fact EVERY effort counts
for a shared task, at least to show your deserving attitude.

#!/usr/bin/perl -w
######
### filter to extract gnatsweb attachments from eMails
### written 2006 by Rado Smiljanic
# Syntax: ... | gnats-mime [filter] | less
# no arg == save files to $PWD, any arg == print to STDOUT
######

my ($line, $file, $num, $name, $len);

### drop leading text
while ($line=<STDIN>) {
        chomp($line);
        last if ($line =~ /----gnatsweb-attachment----/);
}

### loop over all parts
while ($line=<STDIN>) {

$name='dummy';

### get name
while ($line=<STDIN>) {
        chomp($line);
        last if ($line =~ /^ *$/);
        if ($line=~ /name="([^"]+)"/) { $name = $1 ; print STDERR "found name: 
$name\n";}
}

$num=2;
$file=$name;

### serial number not to overwrite
while ( -e $file) {
        die "too many clones for '$name': $num" if ( $num > 8);
        $file = "$name-".$num++;
}

if (! @ARGV) {
print STDERR "extracting to: $file\n";
open(SAVE,">$file") || die "can't open $file";
}

### convert base64 to text
while ($line=<STDIN>) {
        chomp($line);
        last if ($line =~ /^ *$/);
### from 'perldoc -q 64'
        $line =~ tr,A-Za-z0-9+/,,cd;                   # remove non-base64 chars
        $line =~ tr,A-Za-z0-9+/, -_,;                  # convert to uuencoded 
format
        $len = pack("c", 32 + 0.75*length($line));   # compute length byte
if (! @ARGV) {
        print SAVE unpack("u", $len . $line);         # uudecode and print
} else {
        print unpack("u", $len . $line);         # uudecode and print
}
}       ### convert

### skip empty lines after stream
while ($line=~/^ *$/) {
        last if (! defined($line=<STDIN>));
        chomp($line);
}

if (! @ARGV) {
close(SAVE);
}

}       ### loop over all parts

###
# EOF
###