ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/example-decoder
Revision: 1.11
Committed: Mon May 2 19:58:40 2005 UTC (19 years ago) by root
Branch: MAIN
CVS Tags: rel-0_7, rel-1_06, rel-1_08
Changes since 1.10: +3 -0 lines
Log Message:
*** empty log message ***

File Contents

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