ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
(Generate patch)

Comparing Convert-UUlib/UUlib.pm (file contents):
Revision 1.13 by root, Tue Oct 15 23:20:29 2002 UTC vs.
Revision 1.34 by root, Mon Aug 24 04:38:23 2009 UTC

1package Convert::UUlib; 1package Convert::UUlib;
2
3no warnings;
4use strict;
2 5
3use Carp; 6use Carp;
4 7
5require Exporter; 8require Exporter;
6require DynaLoader; 9require DynaLoader;
7 10
8$VERSION = 0.31; 11our $VERSION = '1.12';
9 12
10@ISA = qw(Exporter DynaLoader); 13our @ISA = qw(Exporter DynaLoader);
11 14
12@_consts = qw( 15our @_consts = qw(
13 ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING 16 ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING
14 17
15 FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA 18 FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA
16 FILE_NOEND FILE_OK FILE_READ FILE_TMPFILE 19 FILE_NOEND FILE_OK FILE_READ FILE_TMPFILE
17 20
18 MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING 21 MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING
19 22
23 OPT_RBUF OPT_WBUF
20 OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT 24 OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT
21 OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB 25 OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB
22 OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE 26 OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE
23 OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT 27 OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT OPT_AUTOCHECK
24 28
25 RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA 29 RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA
26 RET_NOEND RET_NOMEM RET_OK RET_UNSUP 30 RET_NOEND RET_NOMEM RET_OK RET_UNSUP
27 31
28 B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED 32 B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED
29 XX_ENCODED UU_ENCODED YENC_ENCODED 33 XX_ENCODED UU_ENCODED YENC_ENCODED
30); 34);
31 35
32@_funcs = qw( 36our @_funcs = qw(
33 Initialize CleanUp GetOption SetOption strerror SetMsgCallback 37 Initialize CleanUp GetOption SetOption strerror SetMsgCallback
34 SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback 38 SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback
35 FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp 39 FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp
36 RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti 40 RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti
37 EncodePartial EncodeToStream EncodeToFile E_PrepSingle 41 EncodePartial EncodeToStream EncodeToFile E_PrepSingle
38 E_PrepPartial 42 E_PrepPartial CheckGlobalList
39 43
40 straction strencoding strmsglevel 44 straction strencoding strmsglevel
41); 45);
42 46
43@EXPORT = @_consts; 47our @EXPORT = @_consts;
44@EXPORT_OK = @_funcs; 48our @EXPORT_OK = @_funcs;
45%EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts); 49our %EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
46 50
47bootstrap Convert::UUlib $VERSION; 51bootstrap Convert::UUlib $VERSION;
48 52
49Initialize(); 53Initialize();
50 54
51# not when < 5.005_6x 55# not when < 5.005_6x
52# END { CleanUp() } 56# END { CleanUp() }
53 57
54for (@_consts) { 58for (@_consts) {
55 my $constant = constant($_); 59 my $constant = constant($_);
60 no strict 'refs';
56 *$_ = sub () { $constant }; 61 *$_ = sub () { $constant };
57} 62}
58 63
59# action code -> string mapping 64# action code -> string mapping
60sub straction($) { 65sub straction($) {
… …
151 OPT_PROGRESS retrieve progress information 156 OPT_PROGRESS retrieve progress information
152 OPT_USETEXT handle text messages 157 OPT_USETEXT handle text messages
153 OPT_PREAMB handle Mime preambles/epilogues 158 OPT_PREAMB handle Mime preambles/epilogues
154 OPT_TINYB64 detect short B64 outside of Mime 159 OPT_TINYB64 detect short B64 outside of Mime
155 OPT_ENCEXT extension for single-part encoded files 160 OPT_ENCEXT extension for single-part encoded files
156 OPT_REMOVE remove input files after decoding 161 OPT_REMOVE remove input files after decoding (dangerous)
157 OPT_MOREMIME strict MIME adherence 162 OPT_MOREMIME strict MIME adherence
158 OPT_DOTDOT .. unescaping has not yet been done on input files 163 OPT_DOTDOT ".."-unescaping has not yet been done on input files
164 OPT_RBUF set default read I/O buffer size in bytes *EXPERIMENTAL*
165 OPT_WBUF set default write I/O buffer size in bytes *EXPERIMENTAL*
159 166
160=head2 Result/Error codes 167=head2 Result/Error codes
161 168
162 RET_OK everything went fine 169 RET_OK everything went fine
163 RET_IOERR I/O Error - examine errno 170 RET_IOERR I/O Error - examine errno
… …
203 210
204Initialize is automatically called when the module is loaded and allocates 211Initialize is automatically called when the module is loaded and allocates
205quite a small amount of memory for todays machines ;) CleanUp releases that 212quite a small amount of memory for todays machines ;) CleanUp releases that
206again. 213again.
207 214
215On my machine, a fairly complete decode with DBI backend needs about 10MB
216RSS to decode 20000 files.
217
208=over 4 218=over 4
209 219
210=item Initialize 220=item Initialize
211 221
212Not normally necessary, (re-)initializes the library. 222Not normally necessary, (re-)initializes the library.
… …
254 264
255=head2 Loading sourcefiles, optionally fuzzy merge and start decoding 265=head2 Loading sourcefiles, optionally fuzzy merge and start decoding
256 266
257=over 4 267=over 4
258 268
259=item ($retval, $count) = LoadFile $fname, [$id, [$delflag]] 269=item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
260 270
261Load the given file and scan it for encoded contents. Optionally tag it 271Load the given file and scan it for encoded contents. Optionally tag it
262with the given id, and if C<$delflag> is true, delete the file after it is 272with the given id, and if C<$delflag> is true, delete the file after it
263no longer necessary. 273is no longer necessary. If you are certain of the part number, you can
274specify it as the last argument.
275
276A better (usually faster) way of doing this is using the C<SetFNameFilter>
277functionality.
264 278
265=item $retval = Smerge $pass 279=item $retval = Smerge $pass
266 280
267If you are desperate, try to call C<Smerge> with increasing C<$pass> 281If you are desperate, try to call C<Smerge> with increasing C<$pass>
268values, beginning at C<0>, to try to merge parts that usually would not 282values, beginning at C<0>, to try to merge parts that usually would not
… …
423=head1 LARGE EXAMPLE DECODER 437=head1 LARGE EXAMPLE DECODER
424 438
425This is the file C<example-decoder> from the distribution, put here 439This is the file C<example-decoder> from the distribution, put here
426instead of more thorough documentation. 440instead of more thorough documentation.
427 441
442 #!/usr/bin/perl
443
428 # decode all the files in the directory uusrc/ and copy 444 # decode all the files in the directory uusrc/ and copy
429 # the resulting files to uudst/ 445 # the resulting files to uudst/
430 446
431 use Convert::UUlib ':all'; 447 use Convert::UUlib ':all';
432 448
433 sub namefilter { 449 sub namefilter {
434 my($path)=@_; 450 my ($path) = @_;
451
435 $path=~s/^.*[\/\\]//; 452 $path=~s/^.*[\/\\]//;
453
436 $path; 454 $path
437 } 455 }
438 456
439 sub busycb { 457 sub busycb {
440 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_; 458 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
441 $_[0]=straction($action); 459 $_[0]=straction($action);
442 print "busy_callback(", (join ",",@_), ")\n"; 460 print "busy_callback(", (join ",",@_), ")\n";
443 0; 461 0
444 } 462 }
445 463
464 SetOption OPT_RBUF, 128*1024;
465 SetOption OPT_WBUF, 1024*1024;
446 SetOption OPT_IGNMODE, 1; 466 SetOption OPT_IGNMODE, 1;
467 SetOption OPT_IGNMODE, 1;
447 SetOption OPT_VERBOSE, 1; 468 SetOption OPT_VERBOSE, 1;
448 469
449 # show the three ways you can set callback functions. I normally 470 # show the three ways you can set callback functions. I normally
450 # prefer the one with the sub inplace. 471 # prefer the one with the sub inplace.
451 SetFNameFilter \&namefilter; 472 SetFNameFilter \&namefilter;
452 473
453 SetBusyCallback "busycb", 333; 474 SetBusyCallback "busycb", 333;
454 475
455 SetMsgCallback sub { 476 SetMsgCallback sub {
456 my ($msg, $level) = @_; 477 my ($msg, $level) = @_;
457 print uc strmsglevel $_[1], ": $msg\n"; 478 print uc strmsglevel $_[1], ": $msg\n";
458 }; 479 };
459 480
460 # the following non-trivial FileNameCallback takes care 481 # the following non-trivial FileNameCallback takes care
461 # of some subject lines not detected properly by uulib: 482 # of some subject lines not detected properly by uulib:
462 SetFileNameCallback sub { 483 SetFileNameCallback sub {
463 return unless $_[1]; # skip "Re:"-plies et al. 484 return unless $_[1]; # skip "Re:"-plies et al.
464 local $_ = $_[0]; 485 local $_ = $_[0];
465 486
466 # the following rules are rather effective on some newsgroups, 487 # the following rules are rather effective on some newsgroups,
467 # like alt.binaries.games.anime, where non-mime, uuencoded data 488 # like alt.binaries.games.anime, where non-mime, uuencoded data
468 # is very common 489 # is very common
469 490
470 # if we find some *.rar, take it as the filename 491 # if we find some *.rar, take it as the filename
471 return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i; 492 return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
472 493
473 # one common subject format 494 # one common subject format
474 return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i; 495 return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
475 496
476 # - filename.par (04/55) 497 # - filename.par (04/55)
477 return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i; 498 return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
478 499
479 # - (xxx) No. 1 sayuri81.jpg 756565 bytes 500 # - (xxx) No. 1 sayuri81.jpg 756565 bytes
480 # - (20 files) No.17 Roseanne.jpg [2/2] 501 # - (20 files) No.17 Roseanne.jpg [2/2]
481 return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/; 502 return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
482 503
504 # try to detect some common forms of filenames
505 return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;
506
483 # otherwise just pass what we have 507 # otherwise just pass what we have
484 return (); 508 ()
485 }; 509 };
486 510
487 # now read all files in the directory uusrc/* 511 # now read all files in the directory uusrc/*
488 for(<uusrc/*>) { 512 for(<uusrc/*>) {
489 my($retval,$count)=LoadFile ($_, $_, 1); 513 my ($retval, $count) = LoadFile ($_, $_, 1);
490 print "file($_), status(", strerror $retval, ") parts($count)\n"; 514 print "file($_), status(", strerror $retval, ") parts($count)\n";
491 } 515 }
492 516
493 SetOption OPT_SAVEPATH, "uudst/"; 517 SetOption OPT_SAVEPATH, "uudst/";
494 518
495 # now wade through all files and their source parts 519 # now wade through all files and their source parts
496 $i = 0; 520 $i = 0;
497 while ($uu = GetFileListItem($i)) { 521 while ($uu = GetFileListItem $i) {
498 $i++; 522 $i++;
499 print "file nr. $i"; 523 print "file nr. $i";
500 print " state ", $uu->state; 524 print " state ", $uu->state;
501 print " mode ", $uu->mode; 525 print " mode ", $uu->mode;
502 print " uudet ", strencoding $uu->uudet; 526 print " uudet ", strencoding $uu->uudet;
503 print " size ", $uu->size; 527 print " size ", $uu->size;
504 print " filename ", $uu->filename; 528 print " filename ", $uu->filename;
505 print " subfname ", $uu->subfname; 529 print " subfname ", $uu->subfname;
506 print " mimeid ", $uu->mimeid; 530 print " mimeid ", $uu->mimeid;
507 print " mimetype ", $uu->mimetype; 531 print " mimetype ", $uu->mimetype;
508 print "\n"; 532 print "\n";
509 533
510 # print additional info about all parts 534 # print additional info about all parts
511 for ($uu->parts) { 535 for ($uu->parts) {
512 while (my ($k, $v) = each %$_) { 536 while (my ($k, $v) = each %$_) {
513 print "$k > $v, "; 537 print "$k > $v, ";
514 } 538 }
515 print "\n"; 539 print "\n";
516 } 540 }
517 541
518 $uu->decode_temp; 542 print $uu->filename;
519 print " temporarily decoded to ", $uu->binfile, "\n"; 543
520 $uu->remove_temp; 544 $uu->remove_temp;
521 545
522 print strerror $uu->decode; 546 if (my $err = $uu->decode ()) {
547 print ", ", strerror $err, "\n";
548 } else {
523 print " saved as uudst/", $uu->filename, "\n"; 549 print ", saved as uudst/", $uu->filename, "\n";
524 } 550 }
551 }
525 552
526 print "cleanup...\n"; 553 print "cleanup...\n";
527 554
528 CleanUp(); 555 CleanUp;
529 556
530=head1 AUTHOR 557=head1 AUTHOR
531 558
532Marc Lehmann <pcg@goof.com>, the original uulib library was written 559Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
533by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily 560by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
534bugfixed by Marc Lehmann. 561bugfixed by Marc Lehmann.
535 562
536=head1 SEE ALSO 563=head1 SEE ALSO
537 564

Diff Legend

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