[ViewVC] Diff of: cvs/Convert-UUlib/UUlib.pm

Comparing Convert-UUlib/UUlib.pm (file contents):
Revision 1.15 by root, Tue Oct 15 23:35:31 2002 UTC vs.
Revision 1.46 by root, Fri Feb 28 06:57:25 2020 UTC

…		…
1	package Convert::UUlib;	1	package Convert::UUlib;
		2
		3	no warnings;
		4	use strict;
2		5
3	use Carp;	6	use Carp;
4		7
5	require Exporter;	8	require Exporter;
6	require DynaLoader;	9	require DynaLoader;
7		10
8	$VERSION = 0.31;	11	our $VERSION = 1.62;
9		12
10	@ISA = qw(Exporter DynaLoader);	13	our @ISA = qw(Exporter DynaLoader);
11		14
12	@_consts = qw(	15	our @_consts = qw(
13	ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING	16	ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING
14		17
15	FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA	18	FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA
16	FILE_NOEND FILE_OK FILE_READ FILE_TMPFILE	19	FILE_NOEND FILE_OK FILE_READ FILE_TMPFILE
17		20
18	MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING	21	MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING
19		22
		23	OPT_RBUF OPT_WBUF
20	OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT	24	OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT
21	OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB	25	OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB
22	OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE	26	OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE
23	OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT	27	OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT OPT_AUTOCHECK
24		28
25	RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA	29	RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA
26	RET_NOEND RET_NOMEM RET_OK RET_UNSUP	30	RET_NOEND RET_NOMEM RET_OK RET_UNSUP
27		31
28	B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED	32	B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED
29	XX_ENCODED UU_ENCODED YENC_ENCODED	33	XX_ENCODED UU_ENCODED YENC_ENCODED
30	);	34	);
31		35
32	@_funcs = qw(	36	our @_funcs = qw(
33	Initialize CleanUp GetOption SetOption strerror SetMsgCallback	37	Initialize CleanUp GetOption SetOption strerror SetMsgCallback
34	SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback	38	SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback
35	FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp	39	FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp
36	RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti	40	RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti
37	EncodePartial EncodeToStream EncodeToFile E_PrepSingle	41	EncodePartial EncodeToStream EncodeToFile E_PrepSingle
38	E_PrepPartial	42	E_PrepPartial
39		43
40	straction strencoding strmsglevel	44	straction strencoding strmsglevel
41	);	45	);
42		46
43	@EXPORT = @_consts;	47	our @EXPORT = @_consts;
44	@EXPORT_OK = @_funcs;	48	our @EXPORT_OK = @_funcs;
45	%EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);	49	our %EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
46		50
47	bootstrap Convert::UUlib $VERSION;	51	bootstrap Convert::UUlib $VERSION;
48		52
49	Initialize();	53	Initialize();
50		54
51	# not when < 5.005_6x	55	# not when < 5.005_6x
52	# END { CleanUp() }	56	# END { CleanUp() }
53		57
54	for (@_consts) {	58	for (@_consts) {
55	my $constant = constant($_);	59	my $constant = constant($_);
		60	no strict 'refs';
56	*$_ = sub () { $constant };	61	*$_ = sub () { $constant };
57	}	62	}
58		63
59	# action code -> string mapping	64	# action code -> string mapping
60	sub straction($) {	65	sub straction($) {
154	OPT_TINYB64 detect short B64 outside of Mime	159	OPT_TINYB64 detect short B64 outside of Mime
155	OPT_ENCEXT extension for single-part encoded files	160	OPT_ENCEXT extension for single-part encoded files
156	OPT_REMOVE remove input files after decoding (dangerous)	161	OPT_REMOVE remove input files after decoding (dangerous)
157	OPT_MOREMIME strict MIME adherence	162	OPT_MOREMIME strict MIME adherence
158	OPT_DOTDOT ".."-unescaping has not yet been done on input files	163	OPT_DOTDOT ".."-unescaping has not yet been done on input files
		164	OPT_RBUF set default read I/O buffer size in bytes
		165	OPT_WBUF set default write I/O buffer size in bytes
		166	OPT_AUTOCHECK automatically check file list after every loadfile
159		167
160	=head2 Result/Error codes	168	=head2 Result/Error codes
161		169
162	RET_OK everything went fine	170	RET_OK everything went fine
163	RET_IOERR I/O Error - examine errno	171	RET_IOERR I/O Error - examine errno
…		…
206	again.	214	again.
207		215
208	On my machine, a fairly complete decode with DBI backend needs about 10MB	216	On my machine, a fairly complete decode with DBI backend needs about 10MB
209	RSS to decode 20000 files.	217	RSS to decode 20000 files.
210		218
211	=over 4	219	=over
212		220
213	=item Initialize	221	=item Initialize
214		222
215	Not normally necessary, (re-)initializes the library.	223	Not normally necessary, (re-)initializes the library.
216		224
…		…
221		229
222	=back	230	=back
223		231
224	=head2 Setting and querying options	232	=head2 Setting and querying options
225		233
226	=over 4	234	=over
227		235
228	=item $option = GetOption OPT_xxx	236	=item $option = GetOption OPT_xxx
229		237
230	=item SetOption OPT_xxx, opt-value	238	=item SetOption OPT_xxx, opt-value
231		239
…		…
233		241
234	See the C<OPT_xxx> constants above to see which options exist.	242	See the C<OPT_xxx> constants above to see which options exist.
235		243
236	=head2 Setting various callbacks	244	=head2 Setting various callbacks
237		245
238	=over 4	246	=over
239		247
240	=item SetMsgCallback [callback-function]	248	=item SetMsgCallback [callback-function]
241		249
242	=item SetBusyCallback [callback-function]	250	=item SetBusyCallback [callback-function]
243		251
…		…
247		255
248	=back	256	=back
249		257
250	=head2 Call the currently selected FNameFilter	258	=head2 Call the currently selected FNameFilter
251		259
252	=over 4	260	=over
253		261
254	=item $file = FNameFilter $file	262	=item $file = FNameFilter $file
255		263
256	=back	264	=back
257		265
258	=head2 Loading sourcefiles, optionally fuzzy merge and start decoding	266	=head2 Loading sourcefiles, optionally fuzzy merge and start decoding
259		267
260	=over 4	268	=over
261		269
262	=item ($retval, $count) = LoadFile $fname, [$id, [$delflag]]	270	=item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
263		271
264	Load the given file and scan it for encoded contents. Optionally tag it	272	Load the given file and scan it for encoded contents. Optionally tag it
265	with the given id, and if C<$delflag> is true, delete the file after it is	273	with the given id, and if C<$delflag> is true, delete the file after it
266	no longer necessary.	274	is no longer necessary. If you are certain of the part number, you can
		275	specify it as the last argument.
		276
		277	A better (usually faster) way of doing this is using the C<SetFNameFilter>
		278	functionality.
267		279
268	=item $retval = Smerge $pass	280	=item $retval = Smerge $pass
269		281
270	If you are desperate, try to call C<Smerge> with increasing C<$pass>	282	If you are desperate, try to call C<Smerge> with increasing C<$pass>
271	values, beginning at C<0>, to try to merge parts that usually would not	283	values, beginning at C<0>, to try to merge parts that usually would not
272	have been merged.	284	have been merged.
273		285
274	Most probably this will result in garbled files, so never do this by	286	Most probably this will result in garbled files, so never do this by
275	default.	287	default, except:
		288
		289	If the C<OPT_AUTOCHECK> option has been disabled (by default it is
		290	enabled) to speed up file loading, then you I<have> to call C<Smerge -1>
		291	after loading all files as an additional pre-pass (which is normally done
		292	by C<LoadFile>).
276		293
277	=item $item = GetFileListItem $item_number	294	=item $item = GetFileListItem $item_number
278		295
279	Return the C<$item> structure for the C<$item_number>'th found file, or	296	Return the C<$item> structure for the C<$item_number>'th found file, or
280	C<undef> of no file with that number exists.	297	C<undef> of no file with that number exists.
…		…
285		302
286	=back	303	=back
287		304
288	=head2 Decoding files	305	=head2 Decoding files
289		306
290	=over 4	307	=over
291		308
292	=item $retval = $item->rename($newname)	309	=item $retval = $item->rename ($newname)
293		310
294	Change the ondisk filename where the decoded file will be saved.	311	Change the ondisk filename where the decoded file will be saved.
295		312
296	=item $retval = $item->decode_temp	313	=item $retval = $item->decode_temp
297		314
…		…
300		317
301	=item $retval = $item->remove_temp	318	=item $retval = $item->remove_temp
302		319
303	Remove the temporarily decoded file again.	320	Remove the temporarily decoded file again.
304		321
305	=item $retval = $item->decode([$target_path])	322	=item $retval = $item->decode ([$target_path])
306		323
307	Decode the file to it's destination, or the given target path.	324	Decode the file to its destination, or the given target path.
308		325
309	=item $retval = $item->info(callback-function)	326	=item $retval = $item->info (callback-function)
310		327
311	=back	328	=back
312		329
313	=head2 Querying (and setting) item attributes	330	=head2 Querying (and setting) item attributes
314		331
315	=over 4	332	=over
316		333
317	=item $state = $item->state	334	=item $state = $item->state
318		335
319	=item $mode = $item->mode([newmode])	336	=item $mode = $item->mode ([newmode])
320		337
321	=item $uudet = $item->uudet	338	=item $uudet = $item->uudet
322		339
323	=item $size = $item->size	340	=item $size = $item->size
324		341
325	=item $filename = $item->filename([newfilename})	342	=item $filename = $item->filename ([newfilename})
326		343
327	=item $subfname = $item->subfname	344	=item $subfname = $item->subfname
328		345
329	=item $mimeid = $item->mimeid	346	=item $mimeid = $item->mimeid
330		347
…		…
334		351
335	=back	352	=back
336		353
337	=head2 Information about source parts	354	=head2 Information about source parts
338		355
339	=over 4	356	=over
340		357
341	=item $parts = $item->parts	358	=item $parts = $item->parts
342		359
343	Return information about all parts (source files) used to decode the file	360	Return information about all parts (source files) used to decode the file
344	as a list of hashrefs with the following structure:	361	as a list of hashrefs with the following structure:
…		…
358	Usually you are interested mostly the C<sfname> and possibly the C<partno>	375	Usually you are interested mostly the C<sfname> and possibly the C<partno>
359	and C<filename> members.	376	and C<filename> members.
360		377
361	=back	378	=back
362		379
363	=head2 Functions below not documented and not very well tested	380	=head2 Functions below are not documented and not very well tested - feedback welcome
364		381
365	QuickDecode	382	QuickDecode
366	EncodeMulti	383	EncodeMulti
367	EncodePartial	384	EncodePartial
368	EncodeToStream	385	EncodeToStream
…		…
372		389
373	=head2 EXTENSION FUNCTIONS	390	=head2 EXTENSION FUNCTIONS
374		391
375	Functions found in this module but not documented in the uulib documentation:	392	Functions found in this module but not documented in the uulib documentation:
376		393
377	=over 4	394	=over
378		395
379	=item $msg = straction ACT_xxx	396	=item $msg = straction ACT_xxx
380		397
381	Return a human readable string representing the given action code.	398	Return a human readable string representing the given action code.
382		399
…		…
426	=head1 LARGE EXAMPLE DECODER	443	=head1 LARGE EXAMPLE DECODER
427		444
428	This is the file C<example-decoder> from the distribution, put here	445	This is the file C<example-decoder> from the distribution, put here
429	instead of more thorough documentation.	446	instead of more thorough documentation.
430		447
		448	#!/usr/bin/perl
		449
431	# decode all the files in the directory uusrc/ and copy	450	# decode all the files in the directory uusrc/ and copy
432	# the resulting files to uudst/	451	# the resulting files to uudst/
433		452
434	use Convert::UUlib ':all';	453	use Convert::UUlib ':all';
435		454
436	sub namefilter {	455	sub namefilter {
437	my($path)=@_;	456	my ($path) = @_;
		457
438	$path=~s/^.*[\/\\]//;	458	$path=~s/^.*[\/\\]//;
		459
439	$path;	460	$path
440	}	461	}
441		462
442	sub busycb {	463	sub busycb {
443	my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;	464	my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
444	$_[0]=straction($action);	465	$_[0]=straction($action);
445	print "busy_callback(", (join ",",@_), ")\n";	466	print "busy_callback(", (join ",",@_), ")\n";
446	0;	467	0
447	}	468	}
448		469
		470	SetOption OPT_RBUF, 128*1024;
		471	SetOption OPT_WBUF, 1024*1024;
449	SetOption OPT_IGNMODE, 1;	472	SetOption OPT_IGNMODE, 1;
		473	SetOption OPT_IGNMODE, 1;
450	SetOption OPT_VERBOSE, 1;	474	SetOption OPT_VERBOSE, 1;
451		475
452	# show the three ways you can set callback functions. I normally	476	# show the three ways you can set callback functions. I normally
453	# prefer the one with the sub inplace.	477	# prefer the one with the sub inplace.
454	SetFNameFilter \&namefilter;	478	SetFNameFilter \&namefilter;
455		479
456	SetBusyCallback "busycb", 333;	480	SetBusyCallback "busycb", 333;
457		481
458	SetMsgCallback sub {	482	SetMsgCallback sub {
459	my ($msg, $level) = @_;	483	my ($msg, $level) = @_;
460	print uc strmsglevel $_[1], ": $msg\n";	484	print uc strmsglevel $_[1], ": $msg\n";
461	};	485	};
462		486
463	# the following non-trivial FileNameCallback takes care	487	# the following non-trivial FileNameCallback takes care
464	# of some subject lines not detected properly by uulib:	488	# of some subject lines not detected properly by uulib:
465	SetFileNameCallback sub {	489	SetFileNameCallback sub {
466	return unless $_[1]; # skip "Re:"-plies et al.	490	return unless $_[1]; # skip "Re:"-plies et al.
467	local $_ = $_[0];	491	local $_ = $_[0];
468		492
469	# the following rules are rather effective on some newsgroups,	493	# the following rules are rather effective on some newsgroups,
470	# like alt.binaries.games.anime, where non-mime, uuencoded data	494	# like alt.binaries.games.anime, where non-mime, uuencoded data
471	# is very common	495	# is very common
472		496
473	# if we find some *.rar, take it as the filename	497	# if we find some *.rar, take it as the filename
474	return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d\|rar))\s/i;	498	return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d\|rar))\s/i;
475		499
476	# one common subject format	500	# one common subject format
477	return $1 if /- "(.{2,}?\..+?)" (?:yenc )?$\d+\/\d+$/i;	501	return $1 if /- "(.{2,}?\..+?)" (?:yenc )?$\d+\/\d+$/i;
478		502
479	# - filename.par (04/55)	503	# - filename.par (04/55)
480	return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?$\d+\/\d+$/i;	504	return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?$\d+\/\d+$/i;
481		505
482	# - (xxx) No. 1 sayuri81.jpg 756565 bytes	506	# - (xxx) No. 1 sayuri81.jpg 756565 bytes
483	# - (20 files) No.17 Roseanne.jpg [2/2]	507	# - (20 files) No.17 Roseanne.jpg [2/2]
484	return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;	508	return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
485		509
		510	# try to detect some common forms of filenames
		511	return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;
		512
486	# otherwise just pass what we have	513	# otherwise just pass what we have
487	return ();	514	()
488	};	515	};
489		516
490	# now read all files in the directory uusrc/*	517	# now read all files in the directory uusrc/*
491	for(<uusrc/*>) {	518	for(<uusrc/*>) {
492	my($retval,$count)=LoadFile ($_, $_, 1);	519	my ($retval, $count) = LoadFile ($_, $_, 1);
493	print "file($_), status(", strerror $retval, ") parts($count)\n";	520	print "file($_), status(", strerror $retval, ") parts($count)\n";
494	}	521	}
495		522
496	SetOption OPT_SAVEPATH, "uudst/";	523	SetOption OPT_SAVEPATH, "uudst/";
497		524
498	# now wade through all files and their source parts	525	# now wade through all files and their source parts
499	$i = 0;	526	$i = 0;
500	while ($uu = GetFileListItem($i)) {	527	while ($uu = GetFileListItem $i) {
501	$i++;	528	$i++;
502	print "file nr. $i";	529	print "file nr. $i";
503	print " state ", $uu->state;	530	print " state ", $uu->state;
504	print " mode ", $uu->mode;	531	print " mode ", $uu->mode;
505	print " uudet ", strencoding $uu->uudet;	532	print " uudet ", strencoding $uu->uudet;
506	print " size ", $uu->size;	533	print " size ", $uu->size;
507	print " filename ", $uu->filename;	534	print " filename ", $uu->filename;
508	print " subfname ", $uu->subfname;	535	print " subfname ", $uu->subfname;
509	print " mimeid ", $uu->mimeid;	536	print " mimeid ", $uu->mimeid;
510	print " mimetype ", $uu->mimetype;	537	print " mimetype ", $uu->mimetype;
511	print "\n";	538	print "\n";
512		539
513	# print additional info about all parts	540	# print additional info about all parts
514	for ($uu->parts) {	541	for ($uu->parts) {
515	while (my ($k, $v) = each %$_) {	542	while (my ($k, $v) = each %$_) {
516	print "$k > $v, ";	543	print "$k > $v, ";
517	}	544	}
518	print "\n";	545	print "\n";
519	}	546	}
520		547
521	$uu->decode_temp;	548	print $uu->filename;
522	print " temporarily decoded to ", $uu->binfile, "\n";	549
523	$uu->remove_temp;	550	$uu->remove_temp;
524		551
525	print strerror $uu->decode;	552	if (my $err = $uu->decode ()) {
		553	print ", ", strerror $err, "\n";
		554	} else {
526	print " saved as uudst/", $uu->filename, "\n";	555	print ", saved as uudst/", $uu->filename, "\n";
527	}	556	}
		557	}
528		558
529	print "cleanup...\n";	559	print "cleanup...\n";
530		560
531	CleanUp();	561	CleanUp;
		562
		563	=head1 PERLMULTICORE SUPPORT
		564
		565	This module supports the perlmulticore standard (see
		566	L<http://perlmulticore.schmorp.de/> for more info) for the following
		567	functions - generally these are functions accessing the disk and/or using
		568	considerable CPU time:
		569
		570	LoadFile
		571	$item->decode
		572	$item->decode_temp
		573	$item->remove_temp
		574	$item->info
		575
		576	The perl interpreter will be reacquired/released on every callback
		577	invocation, so for performance reasons, callbacks should be avoided if
		578	that is costly.
		579
		580	Future versions might enable multicore support for more functions.
		581
		582	=head1 BUGS AND LIMITATIONS
		583
		584	The original uulib library this module uses was written at a time where
		585	main memory of measured in megabytes and buffer overflows as a security
		586	thign didn't exist. While a lot of security fixes have been applied over
		587	the years (includign some defense in depth mechanism that can shield
		588	against a lot of as-of-yet undetected bugs), using this library for
		589	security purposes requires care.
		590
		591	Likewise, file sizes when the uulib library was written were tiny compared
		592	to today, so do not expect this library to handle files larger than 2GB.
532		593
533	=head1 AUTHOR	594	=head1 AUTHOR
534		595
535	Marc Lehmann <pcg@goof.com>, the original uulib library was written	596	Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
536	by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily	597	by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
537	bugfixed by Marc Lehmann.	598	bugfixed by Marc Lehmann.
538		599
539	=head1 SEE ALSO	600	=head1 SEE ALSO
540		601
541	perl(1), uudeview homepage at http://www.uni-frankfurt.de/~fp/uudeview/.	602	perl(1), uudeview homepage at L<http://www.fpx.de/fp/Software/UUDeview/>.
542		603
543	=cut	604	=cut
		605

Diff Legend

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

Comparing Convert-UUlib/UUlib.pm (file contents): Revision 1.15 by root, Tue Oct 15 23:35:31 2002 UTC vs. Revision 1.46 by root, Fri Feb 28 06:57:25 2020 UTC

Diff Legend

Comparing Convert-UUlib/UUlib.pm (file contents):
Revision 1.15 by root, Tue Oct 15 23:35:31 2002 UTC vs.
Revision 1.46 by root, Fri Feb 28 06:57:25 2020 UTC