home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / PERL30X.ZIP / UUMERGE2.PL < prev    next >
Text File  |  1991-01-14  |  3KB  |  119 lines

  1. # From tumuc!fauern!ira.uka.de!smurf!urlichs Mon Jul  9 14:17:00 1990
  2. # Article 1289 of alt.sources:
  3. # Path: lan!tumuc!fauern!ira.uka.de!smurf!urlichs
  4. # From: urlichs@smurf.sub.org (Matthias Urlichs)
  5. # Newsgroups: alt.sources,comp.lang.perl
  6. # Subject: Re: uumerge.pl
  7. # Message-ID: <qskfe2.[75@smurf.sub.org>
  8. # Date: 8 Jul 90 21:17:44 GMT
  9. # References: <1990Jul7.182135.19069@alembic.acs.com>
  10. # Organization: University of Karlsruhe, FRG
  11. # Lines: 105
  12. # Xref: lan alt.sources:1289 comp.lang.perl:1605
  13.  
  14. # In alt.sources, article <1990Jul7.182135.19069@alembic.acs.com>,
  15. #   csu@alembic.acs.com (Dave Mack) writes:
  16. # < #
  17. # < # TODO: modify to allow more than one collection of files on
  18. # < #     command line.
  19. # < #
  20. #
  21. # Well, here's my version; after merging and uudecoding N files per hand I
  22. # decided that enough was enough. (You might guess what newsgroup I'm talking
  23. # about... :-)
  24. #
  25. # It also isn't perturbed if the occasional line in there does start with M.
  26. #
  27. # Warning: My programming style is atrocious, and my Perl style doubly so.
  28. # Especially, the $x? variables really should be an array, the number of M lines
  29. # required should be an option, and the M itself also.
  30.  
  31. #!/usr/local/bin/perl
  32. $files = 0;
  33. $isopen = 0;
  34. $file = "";
  35. $lines = 0;
  36.  
  37. $ARGV[$[] = "-" unless ($#ARGV >= $[);
  38.  
  39. sub nextline {
  40.    local($next) = (0);
  41.    if ($file eq "") { $next = 1; }
  42.    else {
  43.       $_ = <FILE>;
  44.       if ($_ eq "") { $next = 1;  }
  45.    }
  46.    if ($next) {
  47.       $file = $ARGV[$[];
  48.       if ($#ARGV < $[) {
  49.      $_ = "";
  50.       } elsif ($#ARGV >= $[) {
  51.      shift @ARGV;
  52.      print STDERR "Reading $file\n";
  53.      if ($file eq "-") {
  54.         open (FILE,"<&STDIN");
  55.      } else {
  56.         open (FILE,$file);
  57.      }
  58.      $_ = &nextline;
  59.       } else {
  60.      $_ = "";
  61.       }
  62.    }
  63.    $_;
  64. }
  65.  
  66. loop: while(($_ = &nextline) ne "") {
  67.     scan: while (1) {
  68.        if (/^begin\s\d\d\d\s(.*)\s*$/) {
  69.       print STDERR "Writing $1\n";
  70.       open (OUT,"|uudecode");
  71.       print OUT $_;
  72.       $files++;
  73.       $isopen = 1;
  74.       last scan;
  75.        }
  76.     } continue {
  77.        &nextline;
  78.        last loop if ($_ eq "");
  79.     }
  80.  
  81.     $isuu = 3;
  82.     lines: while (($_ = &nextline) ne "") {
  83.        last if /^end/;
  84.        if (/^M/ && $isuu > 2) {
  85.           print OUT $x3, $x2, $x1, $_;
  86.           $x3 = ""; $x2 = ""; $x1 = "";
  87.       $lines++;
  88.           next lines;
  89.        } else {
  90.           $x3 = $x2; $x2 = $x1; $x1 = $_;
  91.       if (/^M/) {
  92.         $isuu++;
  93.       } else {
  94.         $isuu = 0;
  95.       }
  96.        }
  97.     }
  98.  
  99.     print STDERR "$lines lines.\n";
  100.     if (/^end/ && $isopen) {
  101.         print OUT $x3, $x2, $x1, $_;
  102.         close(OUT);
  103.     $isopen = 0;
  104.     } elsif ($isopen) {
  105.     close(OUT);
  106.     die "End of file not found";
  107.     } else {
  108.     die "No files found";
  109.     }
  110.     $lines = 0;
  111. }
  112.  
  113. print STDERR "$files files found.\n";
  114. exit 0;
  115.  
  116. # --
  117. # Matthias Urlichs -- urlichs@smurf.sub.org -- urlichs@smurf.ira.uka.de
  118. # Humboldtstrasse 7 - 7500 Karlsruhe 1 - FRG -- +49+721+621127(Voice)/621227(PEP)
  119.