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

Diff Legend

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