NetNews Usenet Archive 1992 #27/NN_1992_27.iso/spool/comp/lang/perl/7028

Text File | 1992-11-17 | 3.7 KB | 123 lines

Newsgroups: comp.lang.perl
Path: sparky!uunet!mdisea!uw-coco!uw-beaver!fluke!dbc
From: [e-mail] (Dan Carson)
Subject: Re: UUDECODE and perl ...
Message-ID: <[e-mail]>
Organization: John Fluke Mfg. Co., Inc., Everett, WA
References: <[e-mail]>> <[e-mail]> <[e-mail]>
Date: Wed, 18 Nov 1992 00:25:09 GMT
Lines: 112

In article <[e-mail]> [e-mail] writes:
>And here is my patch to Randal's program to allow unpacking more than
>one file at a time. Very handy when, say from nn, you pipe all parts of
>10 binaries through uumerge (the parts have to be in the right order, but
>for me they usually are).
>
>            Sjaak.
>Sjaak Schilperoort                   [e-mail]
>PTT Research, The Netherlands

Our stuff never comes in in order.  For those of you with this problem,
here is an example solution.  It lists subjects in comp.binaries.ibm.pc,
sorts, merges and decodes your selections.  The uudecode part is straight
out of the book.

Disclaimers:
  1) Absolute pathnames may vary.
  2) I'm in analog design.  No guarantees on any software I write.

Dan Carson
[e-mail]
John Fluke Mfg.
Everett, WA


#! /usr/local/perl
#  uudecode stuff in comp.binaries.ibm.pc
#  5/15/91 dbc  Initial version
#  5/31/91 dbc  Only list programs with all parts present
#  1/13/92 dbc  Updated regexp - New moderator changed Subject: format
#  5/14/92 dbc  Sort by date

$regexp = ':[^:]+:\s*(([^,]+).*(\d\d)\/(\d\d).*)'; # Matches 'Subject:' line
$spool  = '/usr/spool/news/comp/binaries/ibm/pc/';

opendir(DIR,$spool) || die "Can't open $spool\n";
@files = readdir(DIR);
@files = grep(/^\d/,@files);             # Articles begin with a number
closedir(DIR);

file: foreach $article (@files) {
  open(IN, $spool . $article) || next file;
  line: while(<IN>) {                    # Memorize Subject: lines
    next line unless /^Subject/;
    ($desc,$prog,$part,$num) = /$regexp/;
    next file unless $prog;
    next file unless $num;
    if($part == 1) {
      $desc{$prog} = $desc ;
      $article1{$prog} = $article;
    }
    $file{$prog} .= "$part/$num:$article ";
    last line;
  }
}

@all = sort {$article1{$a} cmp $article1{$b};} keys %desc;

while($prog = shift @all) {              # List the programs in the spool
  $part  = $file{$prog} =~ tr/:/:/;      # Don't list program if all the
  ($num) = $file{$prog} =~ /\/(\d*):/;   #   parts haven't come in yet
  next if $num != $part;
  push(@prog,$prog);
  $n++;
  printf("%3d  %s\n",$n,$desc{$prog});
}

print "\nTake your pick: ";
chop($in = <>);
@in = split(/[,\s]+/,$in);               # Let user pick programs to decode

while($in = shift @in) {
  if($in =~ /^(\d+)-(\d+)/) {
    unshift(@in,($1 .. $2));
    next;
  }
  @files = sort split(/ /,$file{$prog[$in - 1]});
  grep(s/.*://,@files);
  print "$in: Decoding $prog[$in - 1] articles @files\n";
  foreach $infile (@files) {
    &uudecode($spool . $infile);
  }
  warn "Missing begin in #$in\n" unless $sawbegin;
  warn "Missing end in #$in\n" unless $sawend;
  chmod oct($mode), $file if $mode && $file;
  $sawbegin = $sawend = 0;
}

exit(0);




sub uudecode {
  open(IN, $_[0]);
  unless($sawbegin) {
    while(<IN>) {              # The rest is modified from the book
      $sawbegin++, last if ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
    }
    open(OUT,"> $file") if $file ne "";
  }
  while(<IN>) {
    if(/^end/) {
      $sawend++;
      last;
    }
    s/[a-z]+$//; # handle stupid trailing lowercase letters
    next if /[a-z]/;
    next unless int((((ord() - 32) & 077) + 2) / 3) == int(length() / 4);
    print OUT unpack("u", $_);         # One line does the actual work
  }
}