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.6 by root, Mon Aug 19 23:25:34 2002 UTC vs.
Revision 1.16 by root, Mon Oct 13 12:13:43 2008 UTC

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

Diff Legend

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