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.7 by root, Sun Oct 13 13:47:09 2002 UTC vs.
Revision 1.9 by root, Tue Dec 28 14:09:19 2004 UTC

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

Diff Legend

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