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.11 by root, Mon May 2 19:58:40 2005 UTC vs.
Revision 1.24 by root, Fri Feb 28 16:57:25 2020 UTC

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

Diff Legend

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