ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
Revision: 1.28
Committed: Sun Mar 25 00:18:07 2007 UTC (17 years, 1 month ago) by root
Branch: MAIN
Changes since 1.27: +11 -7 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.28 our $VERSION = '1.08';
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.8 OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT
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     E_PrepPartial
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     # decode all the files in the directory uusrc/ and copy
443     # the resulting files to uudst/
444    
445     use Convert::UUlib ':all';
446    
447     sub namefilter {
448     my($path)=@_;
449     $path=~s/^.*[\/\\]//;
450     $path;
451     }
452    
453     sub busycb {
454     my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
455     $_[0]=straction($action);
456     print "busy_callback(", (join ",",@_), ")\n";
457     0;
458     }
459    
460     SetOption OPT_IGNMODE, 1;
461     SetOption OPT_VERBOSE, 1;
462    
463     # show the three ways you can set callback functions. I normally
464     # prefer the one with the sub inplace.
465     SetFNameFilter \&namefilter;
466    
467     SetBusyCallback "busycb", 333;
468    
469     SetMsgCallback sub {
470     my ($msg, $level) = @_;
471     print uc strmsglevel $_[1], ": $msg\n";
472     };
473    
474     # the following non-trivial FileNameCallback takes care
475     # of some subject lines not detected properly by uulib:
476     SetFileNameCallback sub {
477     return unless $_[1]; # skip "Re:"-plies et al.
478     local $_ = $_[0];
479    
480     # the following rules are rather effective on some newsgroups,
481     # like alt.binaries.games.anime, where non-mime, uuencoded data
482     # is very common
483    
484     # if we find some *.rar, take it as the filename
485     return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
486    
487     # one common subject format
488     return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
489    
490     # - filename.par (04/55)
491     return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
492    
493     # - (xxx) No. 1 sayuri81.jpg 756565 bytes
494     # - (20 files) No.17 Roseanne.jpg [2/2]
495     return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
496    
497     # otherwise just pass what we have
498     return ();
499     };
500    
501     # now read all files in the directory uusrc/*
502     for(<uusrc/*>) {
503     my($retval,$count)=LoadFile ($_, $_, 1);
504     print "file($_), status(", strerror $retval, ") parts($count)\n";
505     }
506    
507     SetOption OPT_SAVEPATH, "uudst/";
508    
509     # now wade through all files and their source parts
510     $i = 0;
511     while ($uu = GetFileListItem($i)) {
512     $i++;
513     print "file nr. $i";
514     print " state ", $uu->state;
515     print " mode ", $uu->mode;
516     print " uudet ", strencoding $uu->uudet;
517     print " size ", $uu->size;
518     print " filename ", $uu->filename;
519     print " subfname ", $uu->subfname;
520     print " mimeid ", $uu->mimeid;
521     print " mimetype ", $uu->mimetype;
522     print "\n";
523    
524     # print additional info about all parts
525     for ($uu->parts) {
526     while (my ($k, $v) = each %$_) {
527     print "$k > $v, ";
528     }
529     print "\n";
530     }
531    
532     $uu->decode_temp;
533     print " temporarily decoded to ", $uu->binfile, "\n";
534     $uu->remove_temp;
535    
536     print strerror $uu->decode;
537     print " saved as uudst/", $uu->filename, "\n";
538     }
539    
540     print "cleanup...\n";
541    
542     CleanUp();
543    
544 root 1.1 =head1 AUTHOR
545    
546 root 1.23 Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
547 root 1.11 by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
548     bugfixed by Marc Lehmann.
549 root 1.1
550     =head1 SEE ALSO
551    
552     perl(1), uudeview homepage at http://www.uni-frankfurt.de/~fp/uudeview/.
553    
554     =cut