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.31 by root, Fri Jun 13 13:33:08 2008 UTC vs.
Revision 1.32 by root, Mon Oct 13 12:12:56 2008 UTC

… …
6use Carp; 6use Carp;
7 7
8require Exporter; 8require Exporter;
9require DynaLoader; 9require DynaLoader;
10 10
11our $VERSION = '1.11'; 11our $VERSION = '1.12';
12 12
13our @ISA = qw(Exporter DynaLoader); 13our @ISA = qw(Exporter DynaLoader);
14 14
15our @_consts = qw( 15our @_consts = qw(
16 ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING 16 ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING
… …
437=head1 LARGE EXAMPLE DECODER 437=head1 LARGE EXAMPLE DECODER
438 438
439This is the file C<example-decoder> from the distribution, put here 439This is the file C<example-decoder> from the distribution, put here
440instead of more thorough documentation. 440instead of more thorough documentation.
441 441
442 #!/usr/bin/perl
443
442 # decode all the files in the directory uusrc/ and copy 444 # decode all the files in the directory uusrc/ and copy
443 # the resulting files to uudst/ 445 # the resulting files to uudst/
444 446
445 use Convert::UUlib ':all'; 447 use Convert::UUlib ':all';
446 448
447 sub namefilter { 449 sub namefilter {
448 my($path)=@_; 450 my ($path) = @_;
451
449 $path=~s/^.*[\/\\]//; 452 $path=~s/^.*[\/\\]//;
453
450 $path; 454 $path
451 } 455 }
452 456
453 sub busycb { 457 sub busycb {
454 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_; 458 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
455 $_[0]=straction($action); 459 $_[0]=straction($action);
456 print "busy_callback(", (join ",",@_), ")\n"; 460 print "busy_callback(", (join ",",@_), ")\n";
457 0; 461 0
458 } 462 }
459 463
464 SetOption OPT_RBUF, 128*1024;
465 SetOption OPT_WBUF, 1024*1024;
460 SetOption OPT_IGNMODE, 1; 466 SetOption OPT_IGNMODE, 1;
467 SetOption OPT_IGNMODE, 1;
461 SetOption OPT_VERBOSE, 1; 468 SetOption OPT_VERBOSE, 1;
462 469
463 # show the three ways you can set callback functions. I normally 470 # show the three ways you can set callback functions. I normally
464 # prefer the one with the sub inplace. 471 # prefer the one with the sub inplace.
465 SetFNameFilter \&namefilter; 472 SetFNameFilter \&namefilter;
466 473
467 SetBusyCallback "busycb", 333; 474 SetBusyCallback "busycb", 333;
468 475
469 SetMsgCallback sub { 476 SetMsgCallback sub {
470 my ($msg, $level) = @_; 477 my ($msg, $level) = @_;
471 print uc strmsglevel $_[1], ": $msg\n"; 478 print uc strmsglevel $_[1], ": $msg\n";
472 }; 479 };
473 480
474 # the following non-trivial FileNameCallback takes care 481 # the following non-trivial FileNameCallback takes care
475 # of some subject lines not detected properly by uulib: 482 # of some subject lines not detected properly by uulib:
476 SetFileNameCallback sub { 483 SetFileNameCallback sub {
477 return unless $_[1]; # skip "Re:"-plies et al. 484 return unless $_[1]; # skip "Re:"-plies et al.
478 local $_ = $_[0]; 485 local $_ = $_[0];
479 486
487 return $1 if /(\S+\s+IMG_\d+.jpg)/i;
488
480 # the following rules are rather effective on some newsgroups, 489 # the following rules are rather effective on some newsgroups,
481 # like alt.binaries.games.anime, where non-mime, uuencoded data 490 # like alt.binaries.games.anime, where non-mime, uuencoded data
482 # is very common 491 # is very common
483 492
484 # if we find some *.rar, take it as the filename 493 # if we find some *.rar, take it as the filename
485 return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i; 494 return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
486 495
487 # one common subject format 496 # one common subject format
488 return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i; 497 return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
489 498
490 # - filename.par (04/55) 499 # - filename.par (04/55)
491 return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i; 500 return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
492 501
493 # - (xxx) No. 1 sayuri81.jpg 756565 bytes 502 # - (xxx) No. 1 sayuri81.jpg 756565 bytes
494 # - (20 files) No.17 Roseanne.jpg [2/2] 503 # - (20 files) No.17 Roseanne.jpg [2/2]
495 return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/; 504 return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
496 505
506 # try to detect some common forms of filenames
507 return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;
508
497 # otherwise just pass what we have 509 # otherwise just pass what we have
498 return (); 510 ()
499 }; 511 };
500 512
501 # now read all files in the directory uusrc/* 513 # now read all files in the directory uusrc/*
502 for(<uusrc/*>) { 514 for(<uusrc/*>) {
503 my($retval,$count)=LoadFile ($_, $_, 1); 515 my ($retval, $count) = LoadFile ($_, $_, 1);
504 print "file($_), status(", strerror $retval, ") parts($count)\n"; 516 print "file($_), status(", strerror $retval, ") parts($count)\n";
505 } 517 }
506 518
507 SetOption OPT_SAVEPATH, "uudst/"; 519 SetOption OPT_SAVEPATH, "uudst/";
508 520
509 # now wade through all files and their source parts 521 # now wade through all files and their source parts
510 $i = 0; 522 $i = 0;
511 while ($uu = GetFileListItem($i)) { 523 while ($uu = GetFileListItem $i) {
512 $i++; 524 $i++;
513 print "file nr. $i"; 525 print "file nr. $i";
514 print " state ", $uu->state; 526 print " state ", $uu->state;
515 print " mode ", $uu->mode; 527 print " mode ", $uu->mode;
516 print " uudet ", strencoding $uu->uudet; 528 print " uudet ", strencoding $uu->uudet;
517 print " size ", $uu->size; 529 print " size ", $uu->size;
518 print " filename ", $uu->filename; 530 print " filename ", $uu->filename;
519 print " subfname ", $uu->subfname; 531 print " subfname ", $uu->subfname;
520 print " mimeid ", $uu->mimeid; 532 print " mimeid ", $uu->mimeid;
521 print " mimetype ", $uu->mimetype; 533 print " mimetype ", $uu->mimetype;
522 print "\n"; 534 print "\n";
523 535
524 # print additional info about all parts 536 # print additional info about all parts
525 for ($uu->parts) { 537 for ($uu->parts) {
526 while (my ($k, $v) = each %$_) { 538 while (my ($k, $v) = each %$_) {
527 print "$k > $v, "; 539 print "$k > $v, ";
528 } 540 }
529 print "\n"; 541 print "\n";
530 } 542 }
531 543
532 $uu->decode_temp; 544 print $uu->filename;
533 print " temporarily decoded to ", $uu->binfile, "\n"; 545
534 $uu->remove_temp; 546 $uu->remove_temp;
535 547
536 print strerror $uu->decode; 548 if (my $err = $uu->decode ()) {
549 print ", ", strerror $err, "\n";
550 } else {
537 print " saved as uudst/", $uu->filename, "\n"; 551 print ", saved as uudst/", $uu->filename, "\n";
538 } 552 }
553 }
539 554
540 print "cleanup...\n"; 555 print "cleanup...\n";
541 556
542 CleanUp(); 557 CleanUp;
543 558
544=head1 AUTHOR 559=head1 AUTHOR
545 560
546Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written 561Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
547by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily 562by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily

Diff Legend

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