home *** CD-ROM | disk | FTP | other *** search
-
- Here's an updated version of my "unpack" perl script (fixed a few bugs).
-
- How to use:
-
- Send mail to Albert's snazzy mail server requesting the items you want.
- When they arrive, stuff them into a mail folder in any order.
- When all the parts of all the items have arrived, run this script on
- the mail folder ("unpack folder" or "unpack < folder"), make sure there
- is an empty directory called "out" for the results.
- If you want it to uudecode the files as well, then use the -uu option.
- The lines which the program thinks are not data are put into a "junk" file
- so you can check that all the data was caught.
- (Files which are not uuencoded will appear in the junk file).
- The parts of the uuencoded files are put in files called "filename.nn"
- in the out directory (truncated to be no more than 10 characters),
- if you use the -uu option then the uudecoded files are put in "filename"
-
- Enjoy!
-
- Martin.
-
- JANET: Martin.Ward@uk.ac.durham Internet (eg US): Martin.Ward@durham.ac.uk
- or if that fails: Martin.Ward%uk.ac.durham@nsfnet-relay.ac.uk
- or even: Martin.Ward%DURHAM.AC.UK@CUNYVM.CUNY.EDU
- BITNET: Martin.Ward%durham.ac.uk@UKACRL UUCP:...!uknet!durham!Martin.Ward
-
-
- #!/usr/local/bin/perl -s
- #
- # unpack: A perl script for unpacking a mail folder.
- #
- # Copyright (C) 1992 Martin Ward
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2 of the License, or
- # (at your option) any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program; if not, write to the Free Software
- # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- #
- #
- # Usage: unpack [-uu] ...
- #
- # A perl script for unpacking a mail folder of messages from the
- # newcastle archimedes archive into individual files
- # into a subdirectory called "out"
- # -uu option means uudecode all the files in the out directory
- #
- # Author: Martin Ward, Computer Science Dept, Durham University, Durham.
- # email: Martin.Ward@durham.ac.uk
- #
-
- ($myname = $0) =~ s|(.*/)*||; # strip path component from name
- $Usage = "Usage: $myname [-uu] ... \n";
-
- $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
- (getpwuid($<))[7] || die "You're homeless!\n";
- $USER = $ENV{'USER'} || getlogin ||
- (getpwuid($<))[0] || die "Your'e nameless!\n";
-
- if (!-d "out") {
- die "No output directory 'out'.\n";
- }
-
- # First "^Subject" after "^From " line should be:
- # Subject: Re: Request: sources; Topic: archimedes filename
- # with an optional (Part n) at the end.
-
- # lines starting with M and length 62 or 63 go to output.
- # lines starting "^begin" go to output and should be changed
- # to create the right filename.
- # lines starting "^end" go to output together with the three previous lines
- # if these have not been output (therefore, need to remember the three
- # previous lines!).
-
- $linenum = 0; # current line number
- $outfile = ""; # current output file
-
- open (JUNK, ">out/junk") || die "Can't open out/junk\n";
-
- while (<>) {
- $linenum++;
- $buf[$linenum % 4] = $_;
- if (/^From /) {
- # a new mail message: close current output (if any)
- if ($outfile ne "") {
- close OUT;
- $outfile = "";
- }
- }
- if (/^Subject: Re: Request: sources; Topic: archimedes/) {
- # send Subject lines to junk file:
- print JUNK;
- # a new subject - open the output file
- if (/\(Part /) {
- # get part number:
- /^Subject: Re: Request: sources; Topic: archimedes (.+) \(Part (\d+)\)$/
- || die "Error in Subject format, line: $linenum\n";
- ($name = $1) =~ s|^.*/||;
- $outfile = substr("out/$name",0,11); # truncate name to 7 chars
- if (length($2) == 1) {
- $outfile .= ".0$2";
- } else {
- $outfile .= ".$2";
- }
- } else {
- # part number must be 01:
- /^Subject: Re: Request: sources; Topic: archimedes (.+)$/
- || die "Error in Subject format, line: $linenum\n";
- ($name = $1) =~ s|^.*/||;
- $outfile = substr("out/$name",0,11); # truncate name to 8 chars
- $outfile .= ".01";
- }
- warn "Output: $outfile already exists, line: $linenum\n\n" if (-f $outfile);
- print "Writing file: $outfile\n";
- close OUT;
- open (OUT, ">$outfile") || die "Can't open $outfile\n";
- } elsif (/^M/ && (length($_) >= 62) && (length($_) <= 64)) {
- # a normal uuencoded line:
- die "Current line has no filename, line: $linenum\n\n" if ($outfile eq "");
- print OUT;
- } elsif (/^begin (\d\d\d) (.+)$/) {
- $filemod = $1;
- $name = $2;
- # a begin line
- if ($outfile eq "") {
- $outfile = "out/$name.01";
- close OUT;
- open (OUT, ">$outfile") || die "Can't open $outfile\n";
- }
- # Change the uudecode filename to $outfile with
- # the part number chopped off:
- $outfile =~ /^out\/(.+).\d\d$/;
- $name = $1;
- print OUT "begin $filemod $name\n";
- } elsif (/^end$/) {
- # an end line: ensure the last three lines have been written,
- # print the end line
- # and close current output.
- die "Current line has no filename, line: $linenum\n\n" if ($outfile eq "");
- for $i (($linenum - 3)..($linenum - 1)) {
- $line = $buf[$i % 4];
- print OUT $line unless (($line =~ /^M/) || ($line =~ /^begin/));
- }
- print OUT "end\n";
- close OUT;
- $outfile = "";
- } else {
- # a junk line - send it to the junk file:
- print JUNK;
- }
- }
- close OUT;
- close JUNK;
-
- exit (0) unless $uu;
-
- chdir("out") || die "Can't chdir to out\n";
- @files = <*.01>;
- foreach $file (@files) {
- ($name = $file) =~ s/\.01$//;
- print "Processing $name\n";
- system "cat $name* | uudecode";
- }
-
-