ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
Revision: 1.13
Committed: Tue Oct 15 23:20:29 2002 UTC (21 years, 7 months ago) by root
Branch: MAIN
Changes since 1.12: +145 -38 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.13 $VERSION = 0.31;
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     OPT_REMOVE remove input files after decoding
157     OPT_MOREMIME strict MIME adherence
158     OPT_DOTDOT .. unescaping has not yet been done on input files
159    
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.1
208 root 1.13 =over 4
209    
210     =item Initialize
211    
212     Not normally necessary, (re-)initializes the library.
213    
214     =item CleanUp
215    
216     Not normally necessary, could be called at the end to release memory
217     before starting a new decoding round.
218    
219     =back
220 root 1.1
221 root 1.11 =head2 Setting and querying options
222 root 1.1
223 root 1.13 =over 4
224    
225     =item $option = GetOption OPT_xxx
226    
227     =item SetOption OPT_xxx, opt-value
228    
229     =back
230    
231     See the C<OPT_xxx> constants above to see which options exist.
232 root 1.1
233 root 1.11 =head2 Setting various callbacks
234 root 1.1
235 root 1.13 =over 4
236    
237     =item SetMsgCallback [callback-function]
238    
239     =item SetBusyCallback [callback-function]
240    
241     =item SetFileCallback [callback-function]
242    
243     =item SetFNameFilter [callback-function]
244    
245     =back
246 root 1.1
247 root 1.11 =head2 Call the currently selected FNameFilter
248 root 1.1
249 root 1.13 =over 4
250    
251     =item $file = FNameFilter $file
252    
253     =back
254 root 1.1
255 root 1.11 =head2 Loading sourcefiles, optionally fuzzy merge and start decoding
256 root 1.1
257 root 1.13 =over 4
258    
259     =item ($retval, $count) = LoadFile $fname, [$id, [$delflag]]
260    
261     Load the given file and scan it for encoded contents. Optionally tag it
262     with the given id, and if C<$delflag> is true, delete the file after it is
263     no longer necessary.
264    
265     =item $retval = Smerge $pass
266    
267     If you are desperate, try to call C<Smerge> with increasing C<$pass>
268     values, beginning at C<0>, to try to merge parts that usually would not
269     have been merged.
270    
271     Most probably this will result in garbled files, so never do this by
272     default.
273    
274     =item $item = GetFileListItem $item_number
275    
276     Return the C<$item> structure for the C<$item_number>'th found file, or
277     C<undef> of no file with that number exists.
278    
279     The first file has number C<0>, and the series has no holes, so you can
280     iterate over all files by starting with zero and incrementing until you
281     hit C<undef>.
282    
283     =back
284    
285     =head2 Decoding files
286    
287     =over 4
288    
289     =item $retval = $item->rename($newname)
290    
291     Change the ondisk filename where the decoded file will be saved.
292    
293     =item $retval = $item->decode_temp
294    
295     Decode the file into a temporary location, use C<< $item->infile >> to
296     retrieve the temporary filename.
297    
298     =item $retval = $item->remove_temp
299    
300     Remove the temporarily decoded file again.
301    
302     =item $retval = $item->decode([$target_path])
303    
304     Decode the file to it's destination, or the given target path.
305    
306     =item $retval = $item->info(callback-function)
307    
308     =back
309 root 1.1
310 root 1.11 =head2 Querying (and setting) item attributes
311 root 1.1
312 root 1.13 =over 4
313    
314     =item $state = $item->state
315    
316     =item $mode = $item->mode([newmode])
317    
318     =item $uudet = $item->uudet
319    
320     =item $size = $item->size
321    
322     =item $filename = $item->filename([newfilename})
323    
324     =item $subfname = $item->subfname
325    
326     =item $mimeid = $item->mimeid
327    
328     =item $mimetype = $item->mimetype
329    
330     =item $binfile = $item->binfile
331    
332     =back
333    
334     =head2 Information about source parts
335    
336     =over 4
337    
338     =item $parts = $item->parts
339    
340     Return information about all parts (source files) used to decode the file
341     as a list of hashrefs with the following structure:
342    
343     {
344     partno => <integer describing the part number, starting with 1>,
345     # the following member sonly exist when they contain useful information
346     sfname => <local pathname of the file where this part is from>,
347     filename => <the ondisk filename of the decoded file>,
348     subfname => <used to cluster postings, possibly the posting filename>,
349     subject => <the subject of the posting/mail>,
350     origin => <the possible source (From) address>,
351     mimetype => <the possible mimetype of the decoded file>,
352     mimeid => <the id part of the Content-Type>,
353     }
354 root 1.1
355 root 1.13 Usually you are interested mostly the C<sfname> and possibly the C<partno>
356     and C<filename> members.
357 root 1.1
358 root 1.13 =back
359 root 1.1
360 root 1.11 =head2 Functions below not documented and not very well tested
361 root 1.1
362 root 1.11 QuickDecode
363     EncodeMulti
364     EncodePartial
365     EncodeToStream
366     EncodeToFile
367     E_PrepSingle
368     E_PrepPartial
369 root 1.6
370     =head2 EXTENSION FUNCTIONS
371    
372     Functions found in this module but not documented in the uulib documentation:
373    
374     =over 4
375    
376 root 1.11 =item $msg = straction ACT_xxx
377    
378     Return a human readable string representing the given action code.
379    
380     =item $msg = strerror RET_xxx
381    
382     Return a human readable string representing the given error code.
383    
384     =item $str = strencoding xxx_ENCODED
385    
386     Return the name of the encoding type as a string.
387    
388     =item $str = strmsglevel MSG_xxx
389    
390     Returns the message level as a string.
391    
392 root 1.6 =item SetFileNameCallback $cb
393    
394     Sets (or queries) the FileNameCallback, which is called whenever the
395     decoding library can't find a filename and wants to extract a filename
396     from the subject line of a posting. The callback will be called with
397     two arguments, the subject line and the current candidate for the
398     filename. The latter argument can be C<undef>, which means that no
399     filename could be found (and likely no one exists, so it is safe to also
400     return C<undef> in this case). If it doesn't return anything (not even
401     C<undef>!), then nothing happens, so this is a no-op callback:
402    
403     sub cb {
404     return ();
405     }
406    
407     If it returns C<undef>, then this indicates that no filename could be
408     found. In all other cases, the return value is taken to be the filename.
409    
410     This is a slightly more useful callback:
411    
412     sub cb {
413     return unless $_[1]; # skip "Re:"-plies et al.
414     my ($subject, $filename) = @_;
415     # if we find some *.rar, take it
416     return $1 if $subject =~ /(\w+\.rar)/;
417     # otherwise just pass what we have
418     return ();
419     }
420    
421     =back
422 root 1.1
423 root 1.11 =head1 LARGE EXAMPLE DECODER
424    
425     This is the file C<example-decoder> from the distribution, put here
426     instead of more thorough documentation.
427    
428     # decode all the files in the directory uusrc/ and copy
429     # the resulting files to uudst/
430    
431     use Convert::UUlib ':all';
432    
433     sub namefilter {
434     my($path)=@_;
435     $path=~s/^.*[\/\\]//;
436     $path;
437     }
438    
439     sub busycb {
440     my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
441     $_[0]=straction($action);
442     print "busy_callback(", (join ",",@_), ")\n";
443     0;
444     }
445    
446     SetOption OPT_IGNMODE, 1;
447     SetOption OPT_VERBOSE, 1;
448    
449     # show the three ways you can set callback functions. I normally
450     # prefer the one with the sub inplace.
451     SetFNameFilter \&namefilter;
452    
453     SetBusyCallback "busycb", 333;
454    
455     SetMsgCallback sub {
456     my ($msg, $level) = @_;
457     print uc strmsglevel $_[1], ": $msg\n";
458     };
459    
460     # the following non-trivial FileNameCallback takes care
461     # of some subject lines not detected properly by uulib:
462     SetFileNameCallback sub {
463     return unless $_[1]; # skip "Re:"-plies et al.
464     local $_ = $_[0];
465    
466     # the following rules are rather effective on some newsgroups,
467     # like alt.binaries.games.anime, where non-mime, uuencoded data
468     # is very common
469    
470     # if we find some *.rar, take it as the filename
471     return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
472    
473     # one common subject format
474     return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
475    
476     # - filename.par (04/55)
477     return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
478    
479     # - (xxx) No. 1 sayuri81.jpg 756565 bytes
480     # - (20 files) No.17 Roseanne.jpg [2/2]
481     return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
482    
483     # otherwise just pass what we have
484     return ();
485     };
486    
487     # now read all files in the directory uusrc/*
488     for(<uusrc/*>) {
489     my($retval,$count)=LoadFile ($_, $_, 1);
490     print "file($_), status(", strerror $retval, ") parts($count)\n";
491     }
492    
493     SetOption OPT_SAVEPATH, "uudst/";
494    
495     # now wade through all files and their source parts
496     $i = 0;
497     while ($uu = GetFileListItem($i)) {
498     $i++;
499     print "file nr. $i";
500     print " state ", $uu->state;
501     print " mode ", $uu->mode;
502     print " uudet ", strencoding $uu->uudet;
503     print " size ", $uu->size;
504     print " filename ", $uu->filename;
505     print " subfname ", $uu->subfname;
506     print " mimeid ", $uu->mimeid;
507     print " mimetype ", $uu->mimetype;
508     print "\n";
509    
510     # print additional info about all parts
511     for ($uu->parts) {
512     while (my ($k, $v) = each %$_) {
513     print "$k > $v, ";
514     }
515     print "\n";
516     }
517    
518     $uu->decode_temp;
519     print " temporarily decoded to ", $uu->binfile, "\n";
520     $uu->remove_temp;
521    
522     print strerror $uu->decode;
523     print " saved as uudst/", $uu->filename, "\n";
524     }
525    
526     print "cleanup...\n";
527    
528     CleanUp();
529    
530 root 1.1 =head1 AUTHOR
531    
532 root 1.11 Marc Lehmann <pcg@goof.com>, the original uulib library was written
533     by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
534     bugfixed by Marc Lehmann.
535 root 1.1
536     =head1 SEE ALSO
537    
538     perl(1), uudeview homepage at http://www.uni-frankfurt.de/~fp/uudeview/.
539    
540     =cut