#!/usr/bin/perl
# decode all the files in the directory uusrc/ and copy
# the resulting files to uudst/
use Convert::UUlib ':all';
sub namefilter {
my ($path) = @_;
$path=~s/^.*[\/\\]//;
$path
}
sub busycb {
my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
$_[0]=straction($action);
print "busy_callback(", (join ",",@_), ")\n";
0
}
SetOption OPT_RBUF, 128*1024;
SetOption OPT_WBUF, 1024*1024;
SetOption OPT_IGNMODE, 1;
SetOption OPT_VERBOSE, 1;
SetOption OPT_DOTDOT, 1;
SetOption OPT_AUTOCHECK, 0;
# show the three ways you can set callback functions. I normally
# prefer the one with the sub inplace.
SetFNameFilter \&namefilter;
SetBusyCallback "busycb", 333;
SetMsgCallback sub {
my ($msg, $level) = @_;
print uc strmsglevel $_[1], ": $msg\n";
};
# the following non-trivial FileNameCallback takes care
# of some subject lines not detected properly by uulib:
SetFileNameCallback sub {
return unless $_[1]; # skip "Re:"-plies et al.
local $_ = $_[0];
if ($_[1] =~ /^(img_?\d+|\d+\w?)\./) {
return "$1 $_[1]"
if /^\s*\(([^)]+)\) \[\d+/;
}
# the following rules are rather effective on some newsgroups,
# like alt.binaries.games.anime, where non-mime, uuencoded data
# is very common
# File 06 of 33 - Kendo - Final - 0001.jpg (2/3)
return $1 if /File \d+ of \d+ - (.*) \(\d+\/\d+\)/i;
# if we find some *.rar, take it as the filename
return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
# one common subject format
return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
# - filename.par (04/55)
return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
# - (xxx) No. 1 sayuri81.jpg 756565 bytes
# - (20 files) No.17 Roseanne.jpg [2/2]
return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
# try to detect some common forms of filenames
return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;
# otherwise just pass what we have
()
};
# now read all files in the directory uusrc/*
for(<uusrc/*>) {
my ($retval, $count) = LoadFile ($_, $_, 1);
print "file($_), status(", strerror $retval, ") parts($count)\n";
}
Smerge -1;
SetOption OPT_SAVEPATH, "uudst/";
# now wade through all files and their source parts
$i = 0;
while ($uu = GetFileListItem $i) {
$i++;
print "file nr. $i";
print " state ", $uu->state;
print " mode ", $uu->mode;
print " uudet ", strencoding $uu->uudet;
print " size ", $uu->size;
print " filename ", $uu->filename;
print " subfname ", $uu->subfname;
print " mimeid ", $uu->mimeid;
print " mimetype ", $uu->mimetype;
print "\n";
# print additional info about all parts
for ($uu->parts) {
while (my ($k, $v) = each %$_) {
print "$k > $v, ";
}
print "\n";
}
print $uu->filename;
$uu->remove_temp;
print "<s", $uu->state, ">";#d#
if (my $err = $uu->decode) {
print ", ", strerror $err, "\n";
} else {
print ", saved as uudst/", $uu->filename, "\n";
}
}
print "cleanup...\n";
CleanUp;