[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 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_IGNMODE, 1;
SetOption OPT_VERBOSE, 1;

# 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];

      return $1 if /(\S+\s+IMG_\d+.jpg)/i;

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

   # 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";
}

SetOption OPT_SAVEPATH, "uudst/";

# now wade through all files and their source parts
$i = 0;
while ($uu = GetFileListItem $i) {
   $i++;
   print "file nr. $i";
   print " state ", $uu->state;
   print " mode ", $uu->mode;
   print " uudet ", strencoding $uu->uudet;
   print " size ", $uu->size;
   print " filename ", $uu->filename;
   print " subfname ", $uu->subfname;
   print " mimeid ", $uu->mimeid;
   print " mimetype ", $uu->mimetype;
   print "\n";

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

   print $uu->filename;

   $uu->remove_temp;

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

print "cleanup...\n";

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