[ViewVC] Annotation of: cvs/Convert-UUlib/example-decoder

#!/usr/bin/perl

# decode all the files in the directory uusrc/ and copy
# the resulting files to uudst/

#use Coro::Multicore;

use strict;

use Convert::UUlib ':all';

sub namefilter {
   my ($path) = @_;

   $path=~s/^.*[\/\\]//;

   $path
}

sub busycb {
   my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
   $_[0]=straction($action);
   print "busy_callback(", (join ",",@_), ")\n";
   0
}

SetOption OPT_RBUF, 128*1024;
SetOption OPT_WBUF, 1024*1024;
SetOption OPT_IGNMODE, 1;
SetOption OPT_VERBOSE, 1;
SetOption OPT_DOTDOT, 1;
SetOption OPT_AUTOCHECK, 0;

# show the three ways you can set callback functions. I normally
# prefer the one with the sub inplace.
SetFNameFilter \&namefilter;

SetBusyCallback "busycb", 333;

SetMsgCallback sub {
   my ($msg, $level) = @_;
   print uc strmsglevel $_[1], ": $msg\n";
};

# the following non-trivial FileNameCallback takes care
# of some subject lines not detected properly by uulib:
SetFileNameCallback sub {
   return unless $_[1]; # skip "Re:"-plies et al.
   local $_ = $_[0];

   if ($_[1] =~ /^(img_?\d+|\d+\w?)\./) {
      return "$1 $_[1]"
         if /^\s*\(([^)]+)\) \[\d+/;
   }

   # the following rules are rather effective on some newsgroups,
   # like alt.binaries.games.anime, where non-mime, uuencoded data
   # is very common

   # File 06 of 33 - Kendo - Final - 0001.jpg (2/3)
   return $1 if /File \d+ of \d+ - (.*) \(\d+\/\d+\)/i;

   # if we find some *.rar, take it as the filename
   return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;

   # one common subject format
   return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;

   # - filename.par (04/55)
   return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;

   # - (xxx) No. 1 sayuri81.jpg 756565 bytes
   # - (20 files) No.17 Roseanne.jpg [2/2]
   return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;

   # try to detect some common forms of filenames
   return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;

   # otherwise just pass what we have
   ()
};

# now read all files in the directory uusrc/*
for(<uusrc/*>) {
   my ($retval, $count) = LoadFile ($_, $_, 1);
   print "file($_), status(", strerror $retval, ") parts($count)\n";
}

Smerge -1;

SetOption OPT_SAVEPATH, "uudst/";

# now wade through all files and their source parts
for my $uu (GetFileList) {
   print "file ", $uu->filename, "\n";
   print " state ", $uu->state, "\n";
   print " mode ", $uu->mode, "\n";
   print " uudet ", strencoding $uu->uudet, "\n";
   print " size ", $uu->size, "\n";
   print " subfname ", $uu->subfname, "\n";
   print " mimeid ", $uu->mimeid, "\n";
   print " mimetype ", $uu->mimetype, "\n";

   # print additional info about all parts
   print " parts";
   for ($uu->parts) {
      for my $k (sort keys %$_) {
         print " $k=$_->{$k}";
      }
      print "\n";
   }

   $uu->remove_temp;

   if (my $err = $uu->decode) {
      print " ERROR ", strerror $err, "\n";
   } else {
      print " successfully saved as uudst/", $uu->filename, "\n";
   }
}

print "cleanup...\n";

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