ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/example-decoder
Revision: 1.6
Committed: Mon Aug 19 23:25:34 2002 UTC (21 years, 9 months ago) by root
Branch: MAIN
Changes since 1.5: +13 -6 lines
Log Message:
*** empty log message ***

File Contents

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