home *** CD-ROM | disk | FTP | other *** search
/ Dream 42 / Amiga_Dream_42.iso / RiscPC / Utils / Archivers / unpack < prev    next >
Encoding:
Text File  |  1997-06-13  |  5.8 KB  |  174 lines

  1.  
  2. Here's an updated version of my "unpack" perl script (fixed a few bugs).
  3.  
  4. How to use:
  5.  
  6. Send mail to Albert's snazzy mail server requesting the items you want.
  7. When they arrive, stuff them into a mail folder in any order.
  8. When all the parts of all the items have arrived, run this script on
  9. the mail folder ("unpack folder" or "unpack < folder"), make sure there
  10. is an empty directory called "out" for the results.
  11. If you want it to uudecode the files as well, then use the -uu option.
  12. The lines which the program thinks are not data are put into a "junk" file
  13. so you can check that all the data was caught. 
  14. (Files which are not uuencoded will appear in the junk file).
  15. The parts of the uuencoded files are put in files called "filename.nn"
  16. in the out directory (truncated to be no more than 10 characters),
  17. if you use the -uu option then the uudecoded files are put in "filename"
  18.  
  19. Enjoy!
  20.  
  21.         Martin.
  22.  
  23. JANET: Martin.Ward@uk.ac.durham    Internet (eg US): Martin.Ward@durham.ac.uk
  24. or if that fails:  Martin.Ward%uk.ac.durham@nsfnet-relay.ac.uk  
  25. or even: Martin.Ward%DURHAM.AC.UK@CUNYVM.CUNY.EDU
  26. BITNET: Martin.Ward%durham.ac.uk@UKACRL UUCP:...!uknet!durham!Martin.Ward
  27.  
  28.  
  29. #!/usr/local/bin/perl -s
  30. # unpack: A perl script for unpacking a mail folder.
  31. #
  32. #    Copyright (C) 1992 Martin Ward
  33. #
  34. #    This program is free software; you can redistribute it and/or modify
  35. #    it under the terms of the GNU General Public License as published by
  36. #    the Free Software Foundation; either version 2 of the License, or
  37. #    (at your option) any later version.
  38. #
  39. #    This program is distributed in the hope that it will be useful,
  40. #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  41. #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  42. #    GNU General Public License for more details.
  43. #
  44. #    You should have received a copy of the GNU General Public License
  45. #    along with this program; if not, write to the Free Software
  46. #    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  47. #
  48. #
  49. # Usage: unpack [-uu] ...
  50. #
  51. # A perl script for unpacking a mail folder of messages from the
  52. # newcastle archimedes archive into individual files
  53. # into a subdirectory called "out"
  54. # -uu option means uudecode all the files in the out directory
  55. #
  56. # Author: Martin Ward, Computer Science Dept, Durham University, Durham.
  57. #  email: Martin.Ward@durham.ac.uk
  58. #
  59.  
  60. ($myname = $0) =~ s|(.*/)*||;    # strip path component from name
  61. $Usage = "Usage: $myname [-uu] ... \n";
  62.  
  63. $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
  64.                 (getpwuid($<))[7] || die "You're homeless!\n";
  65. $USER = $ENV{'USER'} || getlogin ||
  66.                 (getpwuid($<))[0] || die "Your'e nameless!\n";
  67.  
  68. if (!-d "out") {
  69.   die "No output directory 'out'.\n";
  70. }
  71.  
  72. # First "^Subject" after "^From " line should be:
  73. # Subject: Re: Request: sources; Topic: archimedes filename
  74. # with an optional (Part n) at the end.
  75.  
  76. # lines starting with M and length 62 or 63 go to output.
  77. # lines starting "^begin" go to output and should be changed
  78. # to create the right filename.
  79. # lines starting "^end" go to output together with the three previous lines
  80. # if these have not been output (therefore, need to remember the three
  81. # previous lines!).
  82.  
  83. $linenum = 0;    # current line number
  84. $outfile = "";    # current output file
  85.  
  86. open (JUNK, ">out/junk") || die "Can't open out/junk\n";
  87.  
  88. while (<>) {
  89.   $linenum++;
  90.   $buf[$linenum % 4] = $_;
  91.   if (/^From /) {
  92.     # a new mail message: close current output (if any)
  93.     if ($outfile ne "") {
  94.       close OUT;
  95.       $outfile = "";
  96.     }
  97.   }
  98.   if (/^Subject: Re: Request: sources; Topic: archimedes/) {
  99.     # send Subject lines to junk file:
  100.     print JUNK;
  101.     # a new subject - open the output file
  102.     if (/\(Part /) {
  103.       # get part number:
  104.       /^Subject: Re: Request: sources; Topic: archimedes (.+) \(Part (\d+)\)$/
  105.         || die "Error in Subject format, line: $linenum\n";
  106.       ($name = $1) =~ s|^.*/||;
  107.       $outfile = substr("out/$name",0,11);    # truncate name to 7 chars
  108.       if (length($2) == 1) {
  109.         $outfile .= ".0$2";
  110.       } else {
  111.         $outfile .= ".$2";
  112.       }
  113.     } else {
  114.       # part number must be 01:
  115.       /^Subject: Re: Request: sources; Topic: archimedes (.+)$/
  116.         || die "Error in Subject format, line: $linenum\n"; 
  117.       ($name = $1) =~ s|^.*/||;
  118.       $outfile = substr("out/$name",0,11); # truncate name to 8 chars
  119.       $outfile .= ".01";
  120.     }
  121.     warn "Output: $outfile already exists, line: $linenum\n\n" if (-f $outfile);
  122.     print "Writing file: $outfile\n";
  123.     close OUT;
  124.     open (OUT, ">$outfile") || die "Can't open $outfile\n";
  125.   } elsif (/^M/ && (length($_) >= 62) && (length($_) <= 64)) {
  126.     # a normal uuencoded line:
  127.     die "Current line has no filename, line: $linenum\n\n" if ($outfile eq "");
  128.     print OUT;
  129.   } elsif (/^begin (\d\d\d) (.+)$/) {
  130.     $filemod = $1;
  131.     $name = $2;
  132.     # a begin line
  133.     if ($outfile eq "") {
  134.       $outfile = "out/$name.01";
  135.       close OUT;
  136.       open (OUT, ">$outfile") || die "Can't open $outfile\n";
  137.     }
  138.     # Change the uudecode filename to $outfile with 
  139.     # the part number chopped off:
  140.     $outfile =~ /^out\/(.+).\d\d$/;
  141.     $name = $1;
  142.     print OUT "begin $filemod $name\n";
  143.   } elsif (/^end$/) {
  144.     # an end line: ensure the last three lines have been written,
  145.     # print the end line
  146.     # and close current output.
  147.     die "Current line has no filename, line: $linenum\n\n" if ($outfile eq "");
  148.     for $i (($linenum - 3)..($linenum - 1)) {
  149.       $line = $buf[$i % 4];
  150.       print OUT $line unless (($line =~ /^M/) || ($line =~ /^begin/));
  151.     }
  152.     print OUT "end\n";
  153.     close OUT;
  154.     $outfile = "";
  155.   } else {
  156.     # a junk line - send it to the junk file:
  157.     print JUNK;
  158.   }
  159. }
  160. close OUT;
  161. close JUNK;
  162.  
  163. exit (0) unless $uu;
  164.  
  165. chdir("out") || die "Can't chdir to out\n";
  166. @files = <*.01>;
  167. foreach $file (@files) {
  168.   ($name = $file) =~ s/\.01$//;
  169.   print "Processing $name\n";
  170.   system "cat $name* | uudecode";
  171. }
  172.  
  173.