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

Comparing Convert-UUlib/example-decoder (file contents):
Revision 1.3 by root, Sun Mar 31 21:42:36 2002 UTC vs.
Revision 1.23 by root, Fri Feb 28 06:57:43 2020 UTC

1#!/usr/bin/perl 1#!/usr/bin/perl
2 2
3# decode all the files in the directory uusrc/ and copy 3# decode all the files in the directory uusrc/ and copy
4# the resulting files to uudst/ 4# the resulting files to uudst/
5 5
6#use Coro::Multicore;
7
6use Convert::UUlib ':all'; 8use Convert::UUlib ':all';
7 9
8sub namefilter { 10sub namefilter {
9 my($path)=@_; 11 my ($path) = @_;
12
10 $path=~s/^.*[\/\\]//; 13 $path=~s/^.*[\/\\]//;
14
11 $path; 15 $path
12} 16}
13 17
14sub busycb { 18sub busycb {
15 my($action,$curfile,$partno,$numparts,$percent,$fsize)=@_; 19 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
16 $_[0]=straction($action); 20 $_[0]=straction($action);
17 print "busy_callback(",join(",",@_),")\n"; 21 print "busy_callback(", (join ",",@_), ")\n";
18 0; 22 0
19} 23}
20 24
25SetOption OPT_RBUF, 128*1024;
26SetOption OPT_WBUF, 1024*1024;
21SetOption (OPT_IGNMODE, 1); 27SetOption OPT_IGNMODE, 1;
22SetOption (OPT_VERBOSE, 1); 28SetOption OPT_VERBOSE, 1;
29SetOption OPT_DOTDOT, 1;
30SetOption OPT_AUTOCHECK, 0;
23 31
24# show the three ways you can set callback functions 32# show the three ways you can set callback functions. I normally
33# prefer the one with the sub inplace.
25SetFNameFilter (\&namefilter); 34SetFNameFilter \&namefilter;
26 35
27SetBusyCallback ("busycb",333); 36SetBusyCallback "busycb", 333;
28 37
29SetMsgCallback (sub { 38SetMsgCallback sub {
30 my($msg,$level)=@_; 39 my ($msg, $level) = @_;
31 print uc(strmsglevel($_[1])),": $msg\n"; 40 print uc strmsglevel $_[1], ": $msg\n";
32}); 41};
33 42
43# the following non-trivial FileNameCallback takes care
44# of some subject lines not detected properly by uulib:
34SetFileNameCallback sub { 45SetFileNameCallback sub {
35 return unless $_[1]; # skip "Re:"-plies et al. 46 return unless $_[1]; # skip "Re:"-plies et al.
36 my ($subject, $filename) = @_; 47 local $_ = $_[0];
48
49 if ($_[1] =~ /^(img_?\d+|\d+\w?)\./) {
50 return "$1 $_[1]"
51 if /^\s*\(([^)]+)\) \[\d+/;
52 }
53
54 # the following rules are rather effective on some newsgroups,
55 # like alt.binaries.games.anime, where non-mime, uuencoded data
56 # is very common
57
58 # File 06 of 33 - Kendo - Final - 0001.jpg (2/3)
59 return $1 if /File \d+ of \d+ - (.*) \(\d+\/\d+\)/i;
60
37 ## if we find some *.rar, take it 61 # if we find some *.rar, take it as the filename
38 return $1 if $subject =~ /(\S+\.(?:[rstuvwxyz]\d\d|rar))\s/i; 62 return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
63
64 # one common subject format
65 return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
66
67 # - filename.par (04/55)
68 return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
69
70 # - (xxx) No. 1 sayuri81.jpg 756565 bytes
71 # - (20 files) No.17 Roseanne.jpg [2/2]
72 return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
73
74 # try to detect some common forms of filenames
75 return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;
76
39 # otherwise just pass what we have 77 # otherwise just pass what we have
40 return (); 78 ()
41}; 79};
42 80
43 81# now read all files in the directory uusrc/*
44for(<uusrc/*>) { 82for(<uusrc/*>) {
45 my($retval,$count)=LoadFile ($_,$_,1); 83 my ($retval, $count) = LoadFile ($_, $_, 1);
46 print "file($_), status(",strerror($retval),") parts($count)\n"; 84 print "file($_), status(", strerror $retval, ") parts($count)\n";
47} 85}
48 86
49SetOption (OPT_SAVEPATH, "uudst/"); 87Smerge -1;
50 88
89SetOption OPT_SAVEPATH, "uudst/";
90
91# now wade through all files and their source parts
51$i=0; 92$i = 0;
52while($uu=GetFileListItem($i)) { 93while ($uu = GetFileListItem $i) {
53 $i++; 94 $i++;
54 print "file nr. $i"; 95 print "file nr. $i";
55 print " state ",$uu->state; 96 print " state ", $uu->state;
56 print " mode ",$uu->mode; 97 print " mode ", $uu->mode;
57 print " uudet ",strencoding($uu->uudet); 98 print " uudet ", strencoding $uu->uudet;
58 print " size ",$uu->size; 99 print " size ", $uu->size;
59 print " filename ",$uu->filename; 100 print " filename ", $uu->filename;
60 print " subfname ",$uu->subfname; 101 print " subfname ", $uu->subfname;
61 print " mimeid ",$uu->mimeid; 102 print " mimeid ", $uu->mimeid;
62 print " mimetype ",$uu->mimetype; 103 print " mimetype ", $uu->mimetype;
63 print "\n"; 104 print "\n";
64 105
65 # print additional info about all parts 106 # print additional info about all parts
66 for($uu->parts) { 107 for ($uu->parts) {
67 while(my($k,$v)=each(%$_)) { 108 while (my ($k, $v) = each %$_) {
68 print "$k > $v, "; 109 print "$k > $v, ";
69 } 110 }
70 print "\n"; 111 print "\n";
71 } 112 }
72 113
73 print strerror($uu->decode_temp)."\n"; 114 print $uu->filename;
74 print " temporarily decoded to ",$uu->binfile,"\n"; 115
75 $uu->remove_temp; 116 $uu->remove_temp;
76 117
77 print strerror($uu->decode)."\n"; 118 print "<s", $uu->state, ">";#d#
119 if (my $err = $uu->decode) {
120 print ", ", strerror $err, "\n";
121 } else {
78 print " saved as uudst/",$uu->filename,"\n"; 122 print ", saved as uudst/", $uu->filename, "\n";
123 }
79} 124}
80 125
81print "cleanup...\n"; 126print "cleanup...\n";
82 127
83CleanUp(); 128CleanUp;

Diff Legend

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