--- Convert-UUlib/UUlib.pm 2005/02/25 22:02:55 1.22 +++ Convert-UUlib/UUlib.pm 2015/07/10 01:17:08 1.42 @@ -1,15 +1,18 @@ package Convert::UUlib; +no warnings; +use strict; + use Carp; require Exporter; require DynaLoader; -$VERSION = "1.05"; +our $VERSION = 1.5; -@ISA = qw(Exporter DynaLoader); +our @ISA = qw(Exporter DynaLoader); -@_consts = qw( +our @_consts = qw( ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA @@ -17,10 +20,11 @@ MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING + OPT_RBUF OPT_WBUF OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE - OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT + OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT OPT_AUTOCHECK RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA RET_NOEND RET_NOMEM RET_OK RET_UNSUP @@ -29,7 +33,7 @@ XX_ENCODED UU_ENCODED YENC_ENCODED ); -@_funcs = qw( +our @_funcs = qw( Initialize CleanUp GetOption SetOption strerror SetMsgCallback SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp @@ -40,9 +44,9 @@ straction strencoding strmsglevel ); -@EXPORT = @_consts; -@EXPORT_OK = @_funcs; -%EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts); +our @EXPORT = @_consts; +our @EXPORT_OK = @_funcs; +our %EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts); bootstrap Convert::UUlib $VERSION; @@ -53,6 +57,7 @@ for (@_consts) { my $constant = constant($_); + no strict 'refs'; *$_ = sub () { $constant }; } @@ -156,6 +161,9 @@ OPT_REMOVE remove input files after decoding (dangerous) OPT_MOREMIME strict MIME adherence OPT_DOTDOT ".."-unescaping has not yet been done on input files + OPT_RBUF set default read I/O buffer size in bytes + OPT_WBUF set default write I/O buffer size in bytes + OPT_AUTOCHECK automatically check file list after every loadfile =head2 Result/Error codes @@ -276,7 +284,12 @@ have been merged. Most probably this will result in garbled files, so never do this by -default. +default, except: + +If the C option has been disabled (by default it is +enabled) to speed up file loading, then you I to call C +after loading all files as an additional pre-pass (which is normally done +by C). =item $item = GetFileListItem $item_number @@ -432,111 +445,124 @@ This is the file C from the distribution, put here instead of more thorough documentation. - # decode all the files in the directory uusrc/ and copy - # the resulting files to uudst/ + #!/usr/bin/perl - use Convert::UUlib ':all'; + # decode all the files in the directory uusrc/ and copy + # the resulting files to uudst/ - sub namefilter { - my($path)=@_; - $path=~s/^.*[\/\\]//; - $path; - } + use Convert::UUlib ':all'; - sub busycb { - my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_; - $_[0]=straction($action); - print "busy_callback(", (join ",",@_), ")\n"; - 0; - } + sub namefilter { + my ($path) = @_; - SetOption OPT_IGNMODE, 1; - SetOption OPT_VERBOSE, 1; + $path=~s/^.*[\/\\]//; - # 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]; - - # the following rules are rather effective on some newsgroups, - # like alt.binaries.games.anime, where non-mime, uuencoded data - # is very common - - # 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 )?\[/; - - # otherwise just pass what we have - return (); - }; - - # now read all files in the directory uusrc/* - for() { - my($retval,$count)=LoadFile ($_, $_, 1); - print "file($_), status(", strerror $retval, ") parts($count)\n"; - } + $path + } - SetOption OPT_SAVEPATH, "uudst/"; + sub busycb { + my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_; + $_[0]=straction($action); + print "busy_callback(", (join ",",@_), ")\n"; + 0 + } - # 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"; - } + SetOption OPT_RBUF, 128*1024; + SetOption OPT_WBUF, 1024*1024; + SetOption OPT_IGNMODE, 1; + SetOption OPT_IGNMODE, 1; + SetOption OPT_VERBOSE, 1; + + # 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]; + + # the following rules are rather effective on some newsgroups, + # like alt.binaries.games.anime, where non-mime, uuencoded data + # is very common + + # 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() { + my ($retval, $count) = LoadFile ($_, $_, 1); + print "file($_), status(", strerror $retval, ") parts($count)\n"; + } - $uu->decode_temp; - print " temporarily decoded to ", $uu->binfile, "\n"; - $uu->remove_temp; + SetOption OPT_SAVEPATH, "uudst/"; - print strerror $uu->decode; - print " saved as uudst/", $uu->filename, "\n"; - } + # 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; + + if (my $err = $uu->decode ()) { + print ", ", strerror $err, "\n"; + } else { + print ", saved as uudst/", $uu->filename, "\n"; + } + } - print "cleanup...\n"; + print "cleanup...\n"; - CleanUp(); + CleanUp; =head1 AUTHOR -Marc Lehmann , the original uulib library was written +Marc Lehmann , the original uulib library was written by Frank Pilhofer , and later heavily bugfixed by Marc Lehmann.