ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
Revision: 1.22
Committed: Fri Feb 25 22:02:55 2005 UTC (19 years, 2 months ago) by root
Branch: MAIN
CVS Tags: rel-1_05
Changes since 1.21: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 package Convert::UUlib;
2    
3     use Carp;
4    
5     require Exporter;
6     require DynaLoader;
7    
8 root 1.22 $VERSION = "1.05";
9 root 1.1
10     @ISA = qw(Exporter DynaLoader);
11    
12     @_consts = qw(
13     ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING
14    
15     FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA
16     FILE_NOEND FILE_OK FILE_READ FILE_TMPFILE
17    
18     MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING
19    
20     OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT
21     OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB
22     OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE
23 root 1.8 OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT
24 root 1.1
25     RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA
26     RET_NOEND RET_NOMEM RET_OK RET_UNSUP
27    
28 root 1.11 B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED
29 root 1.5 XX_ENCODED UU_ENCODED YENC_ENCODED
30 root 1.1 );
31    
32     @_funcs = qw(
33 root 1.6 Initialize CleanUp GetOption SetOption strerror SetMsgCallback
34     SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback
35     FNameFilter LoadFile GetFileListItem RenameFile DecodeToTemp
36     RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti
37     EncodePartial EncodeToStream EncodeToFile E_PrepSingle
38     E_PrepPartial
39 root 1.1
40     straction strencoding strmsglevel
41     );
42    
43     @EXPORT = @_consts;
44     @EXPORT_OK = @_funcs;
45     %EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
46    
47     bootstrap Convert::UUlib $VERSION;
48    
49     Initialize();
50    
51     # not when < 5.005_6x
52     # END { CleanUp() }
53    
54     for (@_consts) {
55     my $constant = constant($_);
56     *$_ = sub () { $constant };
57     }
58    
59     # action code -> string mapping
60     sub straction($) {
61     return 'copying' if $_[0] == &ACT_COPYING;
62     return 'decoding' if $_[0] == &ACT_DECODING;
63     return 'encoding' if $_[0] == &ACT_ENCODING;
64     return 'idle' if $_[0] == &ACT_IDLE;
65     return 'scanning' if $_[0] == &ACT_SCANNING;
66 root 1.5 'unknown';
67 root 1.1 }
68    
69     # encoding type -> string mapping
70     sub strencoding($) {
71 root 1.5 return 'uuencode' if $_[0] == &UU_ENCODED;
72 root 1.11 return 'base64' if $_[0] == &B64_ENCODED;
73 root 1.5 return 'yenc' if $_[0] == &YENC_ENCODED;
74 root 1.1 return 'binhex' if $_[0] == &BH_ENCODED;
75     return 'plaintext' if $_[0] == &PT_ENCODED;
76     return 'quoted-printable' if $_[0] == &QP_ENCODED;
77     return 'xxencode' if $_[0] == &XX_ENCODED;
78 root 1.5 'unknown';
79 root 1.1 }
80    
81     sub strmsglevel($) {
82     return 'message' if $_[0] == &MSG_MESSAGE;
83     return 'note' if $_[0] == &MSG_NOTE;
84     return 'warning' if $_[0] == &MSG_WARNING;
85     return 'error' if $_[0] == &MSG_ERROR;
86     return 'panic' if $_[0] == &MSG_PANIC;
87     return 'fatal' if $_[0] == &MSG_FATAL;
88 root 1.5 'unknown';
89 root 1.1 }
90    
91     1;
92     __END__
93    
94     =head1 NAME
95    
96     Convert::UUlib - Perl interface to the uulib library (a.k.a. uudeview/uuenview).
97    
98     =head1 SYNOPSIS
99    
100     use Convert::UUlib ':all';
101    
102 root 1.11 # read all the files named on the commandline and decode them
103 root 1.13 # into the CURRENT directory. See below for a longer example.
104     LoadFile $_ for @ARGV;
105     for (my $i = 0; my $uu = GetFileListItem $i; $i++) {
106     if ($uu->state & FILE_OK) {
107     $uu->decode;
108     print $uu->filename, "\n";
109     }
110 root 1.1 }
111    
112 root 1.11 =head1 DESCRIPTION
113 root 1.1
114 root 1.11 Read the file doc/library.pdf from the distribution for in-depth
115     information about the C-library used in this interface, and the rest of
116     this document and especially the non-trivial decoder program at the end.
117    
118     =head1 EXPORTED CONSTANTS
119    
120     =head2 Action code constants
121    
122     ACT_IDLE we don't do anything
123     ACT_SCANNING scanning an input file
124     ACT_DECODING decoding into a temp file
125     ACT_COPYING copying temp to target
126     ACT_ENCODING encoding a file
127    
128     =head2 Message severity levels
129    
130     MSG_MESSAGE just a message, nothing important
131     MSG_NOTE something that should be noticed
132     MSG_WARNING important msg, processing continues
133     MSG_ERROR processing has been terminated
134     MSG_FATAL decoder cannot process further requests
135     MSG_PANIC recovery impossible, app must terminate
136    
137     =head2 Options
138    
139     OPT_VERSION version number MAJOR.MINORplPATCH (ro)
140     OPT_FAST assumes only one part per file
141     OPT_DUMBNESS switch off the program's intelligence
142     OPT_BRACKPOL give numbers in [] higher precendence
143     OPT_VERBOSE generate informative messages
144     OPT_DESPERATE try to decode incomplete files
145     OPT_IGNREPLY ignore RE:plies (off by default)
146     OPT_OVERWRITE whether it's OK to overwrite ex. files
147     OPT_SAVEPATH prefix to save-files on disk
148     OPT_IGNMODE ignore the original file mode
149     OPT_DEBUG print messages with FILE/LINE info
150     OPT_ERRNO get last error code for RET_IOERR (ro)
151     OPT_PROGRESS retrieve progress information
152     OPT_USETEXT handle text messages
153     OPT_PREAMB handle Mime preambles/epilogues
154     OPT_TINYB64 detect short B64 outside of Mime
155     OPT_ENCEXT extension for single-part encoded files
156 root 1.14 OPT_REMOVE remove input files after decoding (dangerous)
157 root 1.11 OPT_MOREMIME strict MIME adherence
158 root 1.15 OPT_DOTDOT ".."-unescaping has not yet been done on input files
159 root 1.11
160     =head2 Result/Error codes
161    
162     RET_OK everything went fine
163     RET_IOERR I/O Error - examine errno
164     RET_NOMEM not enough memory
165     RET_ILLVAL illegal value for operation
166     RET_NODATA decoder didn't find any data
167     RET_NOEND encoded data wasn't ended properly
168     RET_UNSUP unsupported function (encoding)
169     RET_EXISTS file exists (decoding)
170     RET_CONT continue -- special from ScanPart
171     RET_CANCEL operation canceled
172    
173     =head2 File States
174    
175     This code is zero, i.e. "false":
176    
177     UUFILE_READ Read in, but not further processed
178    
179 root 1.13 The following state codes are or'ed together:
180 root 1.11
181     FILE_MISPART Missing Part(s) detected
182     FILE_NOBEGIN No 'begin' found
183     FILE_NOEND No 'end' found
184     FILE_NODATA File does not contain valid uudata
185     FILE_OK All Parts found, ready to decode
186     FILE_ERROR Error while decoding
187     FILE_DECODED Successfully decoded
188     FILE_TMPFILE Temporary decoded file exists
189    
190     =head2 Encoding types
191    
192     UU_ENCODED UUencoded data
193     B64_ENCODED Mime-Base64 data
194     XX_ENCODED XXencoded data
195     BH_ENCODED Binhex encoded
196     PT_ENCODED Plain-Text encoded (MIME)
197     QP_ENCODED Quoted-Printable (MIME)
198     YENC_ENCODED yEnc encoded (non-MIME)
199 root 1.1
200 root 1.11 =head1 EXPORTED FUNCTIONS
201 root 1.1
202 root 1.11 =head2 Initializing and cleanup
203 root 1.1
204 root 1.11 Initialize is automatically called when the module is loaded and allocates
205 root 1.13 quite a small amount of memory for todays machines ;) CleanUp releases that
206     again.
207 root 1.14
208     On my machine, a fairly complete decode with DBI backend needs about 10MB
209     RSS to decode 20000 files.
210 root 1.1
211 root 1.13 =over 4
212    
213     =item Initialize
214    
215     Not normally necessary, (re-)initializes the library.
216    
217     =item CleanUp
218    
219     Not normally necessary, could be called at the end to release memory
220     before starting a new decoding round.
221    
222     =back
223 root 1.1
224 root 1.11 =head2 Setting and querying options
225 root 1.1
226 root 1.13 =over 4
227    
228     =item $option = GetOption OPT_xxx
229    
230     =item SetOption OPT_xxx, opt-value
231    
232     =back
233    
234     See the C<OPT_xxx> constants above to see which options exist.
235 root 1.1
236 root 1.11 =head2 Setting various callbacks
237 root 1.1
238 root 1.13 =over 4
239    
240     =item SetMsgCallback [callback-function]
241    
242     =item SetBusyCallback [callback-function]
243    
244     =item SetFileCallback [callback-function]
245    
246     =item SetFNameFilter [callback-function]
247    
248     =back
249 root 1.1
250 root 1.11 =head2 Call the currently selected FNameFilter
251 root 1.1
252 root 1.13 =over 4
253    
254     =item $file = FNameFilter $file
255    
256     =back
257 root 1.1
258 root 1.11 =head2 Loading sourcefiles, optionally fuzzy merge and start decoding
259 root 1.1
260 root 1.13 =over 4
261    
262 root 1.16 =item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
263 root 1.13
264     Load the given file and scan it for encoded contents. Optionally tag it
265 root 1.16 with the given id, and if C<$delflag> is true, delete the file after it
266 root 1.18 is no longer necessary. If you are certain of the part number, you can
267     specify it as the last argument.
268 root 1.16
269     A better (usually faster) way of doing this is using the C<SetFNameFilter>
270     functionality.
271 root 1.13
272     =item $retval = Smerge $pass
273    
274     If you are desperate, try to call C<Smerge> with increasing C<$pass>
275     values, beginning at C<0>, to try to merge parts that usually would not
276     have been merged.
277    
278     Most probably this will result in garbled files, so never do this by
279     default.
280    
281     =item $item = GetFileListItem $item_number
282    
283     Return the C<$item> structure for the C<$item_number>'th found file, or
284     C<undef> of no file with that number exists.
285    
286     The first file has number C<0>, and the series has no holes, so you can
287     iterate over all files by starting with zero and incrementing until you
288     hit C<undef>.
289    
290     =back
291    
292     =head2 Decoding files
293    
294     =over 4
295    
296     =item $retval = $item->rename($newname)
297    
298     Change the ondisk filename where the decoded file will be saved.
299    
300     =item $retval = $item->decode_temp
301    
302     Decode the file into a temporary location, use C<< $item->infile >> to
303     retrieve the temporary filename.
304    
305     =item $retval = $item->remove_temp
306    
307     Remove the temporarily decoded file again.
308    
309     =item $retval = $item->decode([$target_path])
310    
311     Decode the file to it's destination, or the given target path.
312    
313     =item $retval = $item->info(callback-function)
314    
315     =back
316 root 1.1
317 root 1.11 =head2 Querying (and setting) item attributes
318 root 1.1
319 root 1.13 =over 4
320    
321     =item $state = $item->state
322    
323     =item $mode = $item->mode([newmode])
324    
325     =item $uudet = $item->uudet
326    
327     =item $size = $item->size
328    
329     =item $filename = $item->filename([newfilename})
330    
331     =item $subfname = $item->subfname
332    
333     =item $mimeid = $item->mimeid
334    
335     =item $mimetype = $item->mimetype
336    
337     =item $binfile = $item->binfile
338    
339     =back
340    
341     =head2 Information about source parts
342    
343     =over 4
344    
345     =item $parts = $item->parts
346    
347     Return information about all parts (source files) used to decode the file
348     as a list of hashrefs with the following structure:
349    
350     {
351     partno => <integer describing the part number, starting with 1>,
352     # the following member sonly exist when they contain useful information
353     sfname => <local pathname of the file where this part is from>,
354     filename => <the ondisk filename of the decoded file>,
355     subfname => <used to cluster postings, possibly the posting filename>,
356     subject => <the subject of the posting/mail>,
357     origin => <the possible source (From) address>,
358     mimetype => <the possible mimetype of the decoded file>,
359     mimeid => <the id part of the Content-Type>,
360     }
361 root 1.1
362 root 1.13 Usually you are interested mostly the C<sfname> and possibly the C<partno>
363     and C<filename> members.
364 root 1.1
365 root 1.13 =back
366 root 1.1
367 root 1.11 =head2 Functions below not documented and not very well tested
368 root 1.1
369 root 1.11 QuickDecode
370     EncodeMulti
371     EncodePartial
372     EncodeToStream
373     EncodeToFile
374     E_PrepSingle
375     E_PrepPartial
376 root 1.6
377     =head2 EXTENSION FUNCTIONS
378    
379     Functions found in this module but not documented in the uulib documentation:
380    
381     =over 4
382    
383 root 1.11 =item $msg = straction ACT_xxx
384    
385     Return a human readable string representing the given action code.
386    
387     =item $msg = strerror RET_xxx
388    
389     Return a human readable string representing the given error code.
390    
391     =item $str = strencoding xxx_ENCODED
392    
393     Return the name of the encoding type as a string.
394    
395     =item $str = strmsglevel MSG_xxx
396    
397     Returns the message level as a string.
398    
399 root 1.6 =item SetFileNameCallback $cb
400    
401     Sets (or queries) the FileNameCallback, which is called whenever the
402     decoding library can't find a filename and wants to extract a filename
403     from the subject line of a posting. The callback will be called with
404     two arguments, the subject line and the current candidate for the
405     filename. The latter argument can be C<undef>, which means that no
406     filename could be found (and likely no one exists, so it is safe to also
407     return C<undef> in this case). If it doesn't return anything (not even
408     C<undef>!), then nothing happens, so this is a no-op callback:
409    
410     sub cb {
411     return ();
412     }
413    
414     If it returns C<undef>, then this indicates that no filename could be
415     found. In all other cases, the return value is taken to be the filename.
416    
417     This is a slightly more useful callback:
418    
419     sub cb {
420     return unless $_[1]; # skip "Re:"-plies et al.
421     my ($subject, $filename) = @_;
422     # if we find some *.rar, take it
423     return $1 if $subject =~ /(\w+\.rar)/;
424     # otherwise just pass what we have
425     return ();
426     }
427    
428     =back
429 root 1.1
430 root 1.11 =head1 LARGE EXAMPLE DECODER
431    
432     This is the file C<example-decoder> from the distribution, put here
433     instead of more thorough documentation.
434    
435     # decode all the files in the directory uusrc/ and copy
436     # the resulting files to uudst/
437    
438     use Convert::UUlib ':all';
439    
440     sub namefilter {
441     my($path)=@_;
442     $path=~s/^.*[\/\\]//;
443     $path;
444     }
445    
446     sub busycb {
447     my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
448     $_[0]=straction($action);
449     print "busy_callback(", (join ",",@_), ")\n";
450     0;
451     }
452    
453     SetOption OPT_IGNMODE, 1;
454     SetOption OPT_VERBOSE, 1;
455    
456     # show the three ways you can set callback functions. I normally
457     # prefer the one with the sub inplace.
458     SetFNameFilter \&namefilter;
459    
460     SetBusyCallback "busycb", 333;
461    
462     SetMsgCallback sub {
463     my ($msg, $level) = @_;
464     print uc strmsglevel $_[1], ": $msg\n";
465     };
466    
467     # the following non-trivial FileNameCallback takes care
468     # of some subject lines not detected properly by uulib:
469     SetFileNameCallback sub {
470     return unless $_[1]; # skip "Re:"-plies et al.
471     local $_ = $_[0];
472    
473     # the following rules are rather effective on some newsgroups,
474     # like alt.binaries.games.anime, where non-mime, uuencoded data
475     # is very common
476    
477     # if we find some *.rar, take it as the filename
478     return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
479    
480     # one common subject format
481     return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
482    
483     # - filename.par (04/55)
484     return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
485    
486     # - (xxx) No. 1 sayuri81.jpg 756565 bytes
487     # - (20 files) No.17 Roseanne.jpg [2/2]
488     return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
489    
490     # otherwise just pass what we have
491     return ();
492     };
493    
494     # now read all files in the directory uusrc/*
495     for(<uusrc/*>) {
496     my($retval,$count)=LoadFile ($_, $_, 1);
497     print "file($_), status(", strerror $retval, ") parts($count)\n";
498     }
499    
500     SetOption OPT_SAVEPATH, "uudst/";
501    
502     # now wade through all files and their source parts
503     $i = 0;
504     while ($uu = GetFileListItem($i)) {
505     $i++;
506     print "file nr. $i";
507     print " state ", $uu->state;
508     print " mode ", $uu->mode;
509     print " uudet ", strencoding $uu->uudet;
510     print " size ", $uu->size;
511     print " filename ", $uu->filename;
512     print " subfname ", $uu->subfname;
513     print " mimeid ", $uu->mimeid;
514     print " mimetype ", $uu->mimetype;
515     print "\n";
516    
517     # print additional info about all parts
518     for ($uu->parts) {
519     while (my ($k, $v) = each %$_) {
520     print "$k > $v, ";
521     }
522     print "\n";
523     }
524    
525     $uu->decode_temp;
526     print " temporarily decoded to ", $uu->binfile, "\n";
527     $uu->remove_temp;
528    
529     print strerror $uu->decode;
530     print " saved as uudst/", $uu->filename, "\n";
531     }
532    
533     print "cleanup...\n";
534    
535     CleanUp();
536    
537 root 1.1 =head1 AUTHOR
538    
539 root 1.11 Marc Lehmann <pcg@goof.com>, the original uulib library was written
540     by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
541     bugfixed by Marc Lehmann.
542 root 1.1
543     =head1 SEE ALSO
544    
545     perl(1), uudeview homepage at http://www.uni-frankfurt.de/~fp/uudeview/.
546    
547     =cut