ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
Revision: 1.34
Committed: Mon Aug 24 04:38:23 2009 UTC (14 years, 8 months ago) by root
Branch: MAIN
Changes since 1.33: +2 -2 lines
Log Message:
*** empty log message ***

File Contents

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