[ViewVC] Diff of: cvs/Convert-UUlib/UUlib.pm

Comparing Convert-UUlib/UUlib.pm (file contents):
Revision 1.30 by root, Fri Jun 13 13:27:51 2008 UTC vs.
Revision 1.47 by root, Fri Feb 28 16:57:25 2020 UTC

 use Carp;
 require Exporter;
 require DynaLoader;
-our $VERSION = '1.10';
+our $VERSION = 1.62;
 our @ISA = qw(Exporter DynaLoader);
 our @_consts = qw(
 	ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING
         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
 	B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED
 );
 our @_funcs = qw(
         Initialize CleanUp GetOption SetOption strerror SetMsgCallback
         SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback
-        FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp
+        FNameFilter LoadFile GetFileListItem GetFileList RenameFile DecodeToTemp
         RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti
         EncodePartial EncodeToStream EncodeToFile E_PrepSingle
         E_PrepPartial
         straction strencoding strmsglevel
  use Convert::UUlib ':all';
  # read all the files named on the commandline and decode them
  # into the CURRENT directory. See below for a longer example.
  LoadFile $_ for @ARGV;
- for (my $i = 0; my $uu = GetFileListItem $i; $i++) {
+ for my $uu (GetFileList) {
     if ($uu->state & FILE_OK) {
       $uu->decode;
       print $uu->filename, "\n";
     }
  }
   OPT_TINYB64	detect short B64 outside of Mime
   OPT_ENCEXT	extension for single-part encoded files
   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 *EXPERIMENTAL*
+  OPT_RBUF      set default read I/O buffer size in bytes
-  OPT_WBUF      set default write I/O buffer size in bytes *EXPERIMENTAL*
+  OPT_WBUF      set default write I/O buffer size in bytes
+  OPT_AUTOCHECK automatically check file list after every loadfile
 =head2 Result/Error codes
   RET_OK        everything went fine
   RET_IOERR     I/O Error - examine errno
 again.
 On my machine, a fairly complete decode with DBI backend needs about 10MB
 RSS to decode 20000 files.
-=over 4
+=over
 =item Initialize
 Not normally necessary, (re-)initializes the library.
 =back
 =head2 Setting and querying options
-=over 4
+=over
 =item $option = GetOption OPT_xxx
 =item SetOption OPT_xxx, opt-value
 See the C<OPT_xxx> constants above to see which options exist.
 =head2 Setting various callbacks
-=over 4
+=over
 =item SetMsgCallback [callback-function]
 =item SetBusyCallback [callback-function]
 =back
 =head2 Call the currently selected FNameFilter
-=over 4
+=over
 =item $file = FNameFilter $file
 =back
 =head2 Loading sourcefiles, optionally fuzzy merge and start decoding
-=over 4
+=over
 =item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
 Load the given file and scan it for encoded contents. Optionally tag it
 with the given id, and if C<$delflag> is true, delete the file after it
 If you are desperate, try to call C<Smerge> with increasing C<$pass>
 values, beginning at C<0>, to try to merge parts that usually would not
 have been merged.
 Most probably this will result in garbled files, so never do this by
-default.
+default, except:
+If the C<OPT_AUTOCHECK> option has been disabled (by default it is
+enabled) to speed up file loading, then you I<have> to call C<Smerge -1>
+after loading all files as an additional pre-pass (which is normally done
+by C<LoadFile>).
 =item $item = GetFileListItem $item_number
 Return the C<$item> structure for the C<$item_number>'th found file, or
 C<undef> of no file with that number exists.
 The first file has number C<0>, and the series has no holes, so you can
 iterate over all files by starting with zero and incrementing until you
 hit C<undef>.
+This function has to walk the linear list of fils on each access, so
+if you want to iterate over all items, it is usually faster to use
+C<GetFileList>.
+=item @items = GetFileList
+Similar to C<GetFileListItem>, but returns all files in one go.
 =back
 =head2 Decoding files
-=over 4
+=over
-=item $retval = $item->rename($newname)
+=item $retval = $item->rename ($newname)
 Change the ondisk filename where the decoded file will be saved.
 =item $retval = $item->decode_temp
 =item $retval = $item->remove_temp
 Remove the temporarily decoded file again.
-=item $retval = $item->decode([$target_path])
+=item $retval = $item->decode ([$target_path])
-Decode the file to it's destination, or the given target path.
+Decode the file to its destination, or the given target path.
-=item $retval = $item->info(callback-function)
+=item $retval = $item->info (callback-function)
 =back
 =head2 Querying (and setting) item attributes
-=over 4
+=over
 =item $state    = $item->state
-=item $mode     = $item->mode([newmode])
+=item $mode     = $item->mode ([newmode])
 =item $uudet    = $item->uudet
 =item $size     = $item->size
-=item $filename = $item->filename([newfilename})
+=item $filename = $item->filename ([newfilename})
 =item $subfname = $item->subfname
 =item $mimeid   = $item->mimeid
 =back
 =head2 Information about source parts
-=over 4
+=over
 =item $parts = $item->parts
 Return information about all parts (source files) used to decode the file
 as a list of hashrefs with the following structure:
 Usually you are interested mostly the C<sfname> and possibly the C<partno>
 and C<filename> members.
 =back
-=head2 Functions below not documented and not very well tested
+=head2 Functions below are not documented and not very well tested - feedback welcome
   QuickDecode
   EncodeMulti
   EncodePartial
   EncodeToStream
 =head2 EXTENSION FUNCTIONS
 Functions found in this module but not documented in the uulib documentation:
-=over 4
+=over
 =item $msg = straction ACT_xxx
 Return a human readable string representing the given action code.
 =head1 LARGE EXAMPLE DECODER
 This is the file C<example-decoder> from the distribution, put here
 instead of more thorough documentation.
+   #!/usr/bin/perl
- # decode all the files in the directory uusrc/ and copy
+   # decode all the files in the directory uusrc/ and copy
- # the resulting files to uudst/
+   # the resulting files to uudst/
- use Convert::UUlib ':all';
+   use Convert::UUlib ':all';
- sub namefilter {
+   sub namefilter {
-    my($path)=@_;
+      my ($path) = @_;
-    $path=~s/^.*[\/\\]//;
+      $path=~s/^.*[\/\\]//;
-    $path;
+      $path
- }
+   }
- sub busycb {
+   sub busycb {
-    my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
+      my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
-    $_[0]=straction($action);
+      $_[0]=straction($action);
-    print "busy_callback(", (join ",",@_), ")\n";
+      print "busy_callback(", (join ",",@_), ")\n";
-    0;
+      0
- }
+   }
+   SetOption OPT_RBUF, 128*1024;
+   SetOption OPT_WBUF, 1024*1024;
- SetOption OPT_IGNMODE, 1;
+   SetOption OPT_IGNMODE, 1;
+   SetOption OPT_IGNMODE, 1;
- SetOption OPT_VERBOSE, 1;
+   SetOption OPT_VERBOSE, 1;
- # show the three ways you can set callback functions. I normally
+   # show the three ways you can set callback functions. I normally
- # prefer the one with the sub inplace.
+   # prefer the one with the sub inplace.
- SetFNameFilter \&namefilter;
+   SetFNameFilter \&namefilter;
- SetBusyCallback "busycb", 333;
+   SetBusyCallback "busycb", 333;
- SetMsgCallback sub {
+   SetMsgCallback sub {
-    my ($msg, $level) = @_;
+      my ($msg, $level) = @_;
-    print uc strmsglevel $_[1], ": $msg\n";
+      print uc strmsglevel $_[1], ": $msg\n";
- };
+   };
- # the following non-trivial FileNameCallback takes care
+   # the following non-trivial FileNameCallback takes care
- # of some subject lines not detected properly by uulib:
+   # of some subject lines not detected properly by uulib:
- SetFileNameCallback sub {
+   SetFileNameCallback sub {
-    return unless $_[1]; # skip "Re:"-plies et al.
+      return unless $_[1]; # skip "Re:"-plies et al.
-    local $_ = $_[0];
+      local $_ = $_[0];
-    # the following rules are rather effective on some newsgroups,
+      # the following rules are rather effective on some newsgroups,
-    # like alt.binaries.games.anime, where non-mime, uuencoded data
+      # like alt.binaries.games.anime, where non-mime, uuencoded data
-    # is very common
+      # is very common
-    # if we find some *.rar, take it as the filename
+      # if we find some *.rar, take it as the filename
-    return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
+      return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
-    # one common subject format
+      # one common subject format
-    return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
+      return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
-    # - filename.par (04/55)
+      # - filename.par (04/55)
-    return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
+      return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
-    # - (xxx) No. 1 sayuri81.jpg 756565 bytes
+      # - (xxx) No. 1 sayuri81.jpg 756565 bytes
-    # - (20 files) No.17 Roseanne.jpg [2/2]
+      # - (20 files) No.17 Roseanne.jpg [2/2]
-    return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
+      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
+      # otherwise just pass what we have
-    return ();
+      ()
- };
+   };
- # now read all files in the directory uusrc/*
+   # now read all files in the directory uusrc/*
- for(<uusrc/*>) {
+   for (<uusrc/*>) {
-    my($retval,$count)=LoadFile ($_, $_, 1);
+      my ($retval, $count) = LoadFile ($_, $_, 1);
-    print "file($_), status(", strerror $retval, ") parts($count)\n";
+      print "file($_), status(", strerror $retval, ") parts($count)\n";
- }
+   }
- SetOption OPT_SAVEPATH, "uudst/";
+   SetOption OPT_SAVEPATH, "uudst/";
- # now wade through all files and their source parts
+   # now wade through all files and their source parts
- $i = 0;
+   for my $uu (GetFileList) {
- while ($uu = GetFileListItem($i)) {
+      print "file ", $uu->filename, "\n";
-    $i++;
-    print "file nr. $i";
-    print " state ", $uu->state;
+      print " state ", $uu->state, "\n";
-    print " mode ", $uu->mode;
+      print " mode ", $uu->mode, "\n";
-    print " uudet ", strencoding $uu->uudet;
+      print " uudet ", strencoding $uu->uudet, "\n";
-    print " size ", $uu->size;
+      print " size ", $uu->size, "\n";
-    print " filename ", $uu->filename;
-    print " subfname ", $uu->subfname;
+      print " subfname ", $uu->subfname, "\n";
-    print " mimeid ", $uu->mimeid;
+      print " mimeid ", $uu->mimeid, "\n";
-    print " mimetype ", $uu->mimetype;
+      print " mimetype ", $uu->mimetype, "\n";
-    print "\n";
-    # print additional info about all parts
+      # print additional info about all parts
+      print " parts";
-    for ($uu->parts) {
+      for ($uu->parts) {
-       while (my ($k, $v) = each %$_) {
+         for my $k (sort keys %$_) {
-          print "$k > $v, ";
+            print " $k=$_->{$k}";
-       }
+         }
-       print "\n";
+         print "\n";
-    }
+      }
-    $uu->decode_temp;
-    print " temporarily decoded to ", $uu->binfile, "\n";
-    $uu->remove_temp;
+      $uu->remove_temp;
-    print strerror $uu->decode;
+      if (my $err = $uu->decode) {
+         print " ERROR ", strerror $err, "\n";
+      } else {
-    print " saved as uudst/", $uu->filename, "\n";
+         print " successfully saved as uudst/", $uu->filename, "\n";
- }
+      }
+   }
- print "cleanup...\n";
+   print "cleanup...\n";
- CleanUp();
+   CleanUp;
+=head1 PERLMULTICORE SUPPORT
+This module supports the perlmulticore standard (see
+L<http://perlmulticore.schmorp.de/> for more info) for the following
+functions - generally these are functions accessing the disk and/or using
+considerable CPU time:
+   LoadFile
+   $item->decode
+   $item->decode_temp
+   $item->remove_temp
+   $item->info
+The perl interpreter will be reacquired/released on every callback
+invocation, so for performance reasons, callbacks should be avoided if
+that is costly.
+Future versions might enable multicore support for more functions.
+=head1 BUGS AND LIMITATIONS
+The original uulib library this module uses was written at a time where
+main memory of measured in megabytes and buffer overflows as a security
+thign didn't exist. While a lot of security fixes have been applied over
+the years (includign some defense in depth mechanism that can shield
+against a lot of as-of-yet undetected bugs), using this library for
+security purposes requires care.
+Likewise, file sizes when the uulib library was written were tiny compared
+to today, so do not expect this library to handle files larger than 2GB.
 =head1 AUTHOR
 Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
 by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
 bugfixed by Marc Lehmann.
 =head1 SEE ALSO
-perl(1), uudeview homepage at http://www.uni-frankfurt.de/~fp/uudeview/.
+perl(1), uudeview homepage at L<http://www.fpx.de/fp/Software/UUDeview/>.
 =cut

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Convert-UUlib/UUlib.pm (file contents): Revision 1.30 by root, Fri Jun 13 13:27:51 2008 UTC vs. Revision 1.47 by root, Fri Feb 28 16:57:25 2020 UTC

Diff Legend

Comparing Convert-UUlib/UUlib.pm (file contents):
Revision 1.30 by root, Fri Jun 13 13:27:51 2008 UTC vs.
Revision 1.47 by root, Fri Feb 28 16:57:25 2020 UTC