| … | |
… | |
| 258 | |
258 | |
| 259 | LARGE EXAMPLE DECODER |
259 | LARGE EXAMPLE DECODER |
| 260 | This is the file "example-decoder" from the distribution, put here |
260 | This is the file "example-decoder" from the distribution, put here |
| 261 | instead of more thorough documentation. |
261 | instead of more thorough documentation. |
| 262 | |
262 | |
|
|
263 | #!/usr/bin/perl |
|
|
264 | |
| 263 | # decode all the files in the directory uusrc/ and copy |
265 | # decode all the files in the directory uusrc/ and copy |
| 264 | # the resulting files to uudst/ |
266 | # the resulting files to uudst/ |
| 265 | |
267 | |
| 266 | use Convert::UUlib ':all'; |
268 | use Convert::UUlib ':all'; |
| 267 | |
269 | |
| 268 | sub namefilter { |
270 | sub namefilter { |
| 269 | my($path)=@_; |
271 | my ($path) = @_; |
|
|
272 | |
| 270 | $path=~s/^.*[\/\\]//; |
273 | $path=~s/^.*[\/\\]//; |
|
|
274 | |
| 271 | $path; |
275 | $path |
| 272 | } |
276 | } |
| 273 | |
277 | |
| 274 | sub busycb { |
278 | sub busycb { |
| 275 | my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_; |
279 | my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_; |
| 276 | $_[0]=straction($action); |
280 | $_[0]=straction($action); |
| 277 | print "busy_callback(", (join ",",@_), ")\n"; |
281 | print "busy_callback(", (join ",",@_), ")\n"; |
| 278 | 0; |
282 | 0 |
| 279 | } |
283 | } |
| 280 | |
284 | |
|
|
285 | SetOption OPT_RBUF, 128*1024; |
|
|
286 | SetOption OPT_WBUF, 1024*1024; |
| 281 | SetOption OPT_IGNMODE, 1; |
287 | SetOption OPT_IGNMODE, 1; |
|
|
288 | SetOption OPT_IGNMODE, 1; |
| 282 | SetOption OPT_VERBOSE, 1; |
289 | SetOption OPT_VERBOSE, 1; |
| 283 | |
290 | |
| 284 | # show the three ways you can set callback functions. I normally |
291 | # show the three ways you can set callback functions. I normally |
| 285 | # prefer the one with the sub inplace. |
292 | # prefer the one with the sub inplace. |
| 286 | SetFNameFilter \&namefilter; |
293 | SetFNameFilter \&namefilter; |
| 287 | |
294 | |
| 288 | SetBusyCallback "busycb", 333; |
295 | SetBusyCallback "busycb", 333; |
| 289 | |
296 | |
| 290 | SetMsgCallback sub { |
297 | SetMsgCallback sub { |
| 291 | my ($msg, $level) = @_; |
298 | my ($msg, $level) = @_; |
| 292 | print uc strmsglevel $_[1], ": $msg\n"; |
299 | print uc strmsglevel $_[1], ": $msg\n"; |
| 293 | }; |
300 | }; |
| 294 | |
301 | |
| 295 | # the following non-trivial FileNameCallback takes care |
302 | # the following non-trivial FileNameCallback takes care |
| 296 | # of some subject lines not detected properly by uulib: |
303 | # of some subject lines not detected properly by uulib: |
| 297 | SetFileNameCallback sub { |
304 | SetFileNameCallback sub { |
| 298 | return unless $_[1]; # skip "Re:"-plies et al. |
305 | return unless $_[1]; # skip "Re:"-plies et al. |
| 299 | local $_ = $_[0]; |
306 | local $_ = $_[0]; |
| 300 | |
307 | |
|
|
308 | return $1 if /(\S+\s+IMG_\d+.jpg)/i; |
|
|
309 | |
| 301 | # the following rules are rather effective on some newsgroups, |
310 | # the following rules are rather effective on some newsgroups, |
| 302 | # like alt.binaries.games.anime, where non-mime, uuencoded data |
311 | # like alt.binaries.games.anime, where non-mime, uuencoded data |
| 303 | # is very common |
312 | # is very common |
| 304 | |
313 | |
| 305 | # if we find some *.rar, take it as the filename |
314 | # if we find some *.rar, take it as the filename |
| 306 | return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i; |
315 | return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i; |
| 307 | |
316 | |
| 308 | # one common subject format |
317 | # one common subject format |
| 309 | return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i; |
318 | return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i; |
| 310 | |
319 | |
| 311 | # - filename.par (04/55) |
320 | # - filename.par (04/55) |
| 312 | return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i; |
321 | return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i; |
| 313 | |
322 | |
| 314 | # - (xxx) No. 1 sayuri81.jpg 756565 bytes |
323 | # - (xxx) No. 1 sayuri81.jpg 756565 bytes |
| 315 | # - (20 files) No.17 Roseanne.jpg [2/2] |
324 | # - (20 files) No.17 Roseanne.jpg [2/2] |
| 316 | return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/; |
325 | return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/; |
| 317 | |
326 | |
|
|
327 | # try to detect some common forms of filenames |
|
|
328 | return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i; |
|
|
329 | |
| 318 | # otherwise just pass what we have |
330 | # otherwise just pass what we have |
| 319 | return (); |
331 | () |
| 320 | }; |
332 | }; |
| 321 | |
333 | |
| 322 | # now read all files in the directory uusrc/* |
334 | # now read all files in the directory uusrc/* |
| 323 | for(<uusrc/*>) { |
335 | for(<uusrc/*>) { |
| 324 | my($retval,$count)=LoadFile ($_, $_, 1); |
336 | my ($retval, $count) = LoadFile ($_, $_, 1); |
| 325 | print "file($_), status(", strerror $retval, ") parts($count)\n"; |
337 | print "file($_), status(", strerror $retval, ") parts($count)\n"; |
| 326 | } |
338 | } |
| 327 | |
339 | |
| 328 | SetOption OPT_SAVEPATH, "uudst/"; |
340 | SetOption OPT_SAVEPATH, "uudst/"; |
| 329 | |
341 | |
| 330 | # now wade through all files and their source parts |
342 | # now wade through all files and their source parts |
| 331 | $i = 0; |
343 | $i = 0; |
| 332 | while ($uu = GetFileListItem($i)) { |
344 | while ($uu = GetFileListItem $i) { |
| 333 | $i++; |
345 | $i++; |
| 334 | print "file nr. $i"; |
346 | print "file nr. $i"; |
| 335 | print " state ", $uu->state; |
347 | print " state ", $uu->state; |
| 336 | print " mode ", $uu->mode; |
348 | print " mode ", $uu->mode; |
| 337 | print " uudet ", strencoding $uu->uudet; |
349 | print " uudet ", strencoding $uu->uudet; |
| 338 | print " size ", $uu->size; |
350 | print " size ", $uu->size; |
| 339 | print " filename ", $uu->filename; |
351 | print " filename ", $uu->filename; |
| 340 | print " subfname ", $uu->subfname; |
352 | print " subfname ", $uu->subfname; |
| 341 | print " mimeid ", $uu->mimeid; |
353 | print " mimeid ", $uu->mimeid; |
| 342 | print " mimetype ", $uu->mimetype; |
354 | print " mimetype ", $uu->mimetype; |
| 343 | print "\n"; |
355 | print "\n"; |
| 344 | |
356 | |
| 345 | # print additional info about all parts |
357 | # print additional info about all parts |
| 346 | for ($uu->parts) { |
358 | for ($uu->parts) { |
| 347 | while (my ($k, $v) = each %$_) { |
359 | while (my ($k, $v) = each %$_) { |
| 348 | print "$k > $v, "; |
360 | print "$k > $v, "; |
| 349 | } |
361 | } |
| 350 | print "\n"; |
362 | print "\n"; |
| 351 | } |
363 | } |
| 352 | |
364 | |
| 353 | $uu->decode_temp; |
365 | print $uu->filename; |
| 354 | print " temporarily decoded to ", $uu->binfile, "\n"; |
366 | |
| 355 | $uu->remove_temp; |
367 | $uu->remove_temp; |
| 356 | |
368 | |
| 357 | print strerror $uu->decode; |
369 | if (my $err = $uu->decode ()) { |
|
|
370 | print ", ", strerror $err, "\n"; |
|
|
371 | } else { |
| 358 | print " saved as uudst/", $uu->filename, "\n"; |
372 | print ", saved as uudst/", $uu->filename, "\n"; |
|
|
373 | } |
| 359 | } |
374 | } |
| 360 | |
375 | |
| 361 | print "cleanup...\n"; |
376 | print "cleanup...\n"; |
| 362 | |
377 | |
| 363 | CleanUp(); |
378 | CleanUp; |
| 364 | |
379 | |
| 365 | AUTHOR |
380 | AUTHOR |
| 366 | Marc Lehmann <schmorp@schmorp.de>, the original uulib library was |
381 | Marc Lehmann <schmorp@schmorp.de>, the original uulib library was |
| 367 | written by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later |
382 | written by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later |
| 368 | heavily bugfixed by Marc Lehmann. |
383 | heavily bugfixed by Marc Lehmann. |
