Article 8153 of comp.lang.perl:
Xref: feenix.metronet.com alt.binaries.pictures.supermodels:6827 alt.binaries.pictures:1549 alt.binaries.pictures.erotica:38151 alt.binaries.pictures.misc:22674 comp.lang.perl:8153
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!europa.eng.gtefsd.com!uunet!olivea!pagesat!news.cerf.net!nic.cerf.net!vigs2
From: vigs2@nic.cerf.net (Rick Schlientz)
Newsgroups: alt.binaries.pictures.supermodels,alt.binaries.pictures,alt.binaries.pictures.erotica,alt.binaries.pictures.misc,comp.lang.perl
Subject: uudconc - a perl uudecoding utility for multiple target files.
Followup-To: alt.binaries.pictures.d
Date: 19 Nov 1993 20:15:35 GMT
Organization: CERFnet Dial n' CERF Customer
Lines: 253
Distribution: world
Message-ID: <2cj9h7$o1b@news.cerf.net>
NNTP-Posting-Host: nic.cerf.net
Keywords: perl, uuencode, uudconc, uudecode

This script is used to uudecode files that are all strung together in one
long file.  I came up with the idea for the script from my news use - I'm
always saving all the binary files into one big news save file (because
I'm too lazy to type a new name for each file, and I don't like doing
extra work ;-).

The only real requirement for this script to work is that the parts of
the file be saved in order.  It's really fairly smart as far as "throwing
out" extraneous stuff that doesn't belong in the uuencoded file.

There aren't a lot in the way of error messages.  As each new file is
encountered, it's name is printed out on STDERR.  And error messages are
generated if a new file is started before the end statement of the
current one, or if an end statement is reached with no beginning
statement.

Here are the assumptions that I've made about the uuencoded data:

o     Lines with lower-case in them are bogus and are thrown out.

o     Blank lines are likewise bogus.

o     Lines that don't begin with M are bogus, unless they are just
      before the end statement.  If supposedly valid lines get that far,
      but another valid line beginning with M shows up, the "non-M" lines
      are dumped into the bit-bucket.

The script is admittedly a bit primitive, but it works well enough for my
uses, so I figured that I'd share what I had with anyone who wants it.

Credit where credit is due:  This script is losely based on the uudecode
sample program on page 198 of the Programming Perl book from O'Reilly.
Thank you Larry Wall (and thank you Randal Schwartz)!

----CUT HERE------------------------------------
#!/bin/sh
# This is a shell archive (shar 3.32)
# made 11/19/1993 19:45 UTC by rick@gamma
# Source directory /tmp_mnt/net/barkley/export/home1/rick/admin/work/uudconc
#
# existing files WILL be overwritten
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   5776 -r-xr-xr-x uudconc.pl
#
if touch 2>&1 | fgrep 'amc' > /dev/null
 then TOUCH=touch
 else TOUCH=true
fi
# ============= uudconc.pl ==============
echo "x - extracting uudconc.pl (Text)"
sed 's/^X//' << 'SHAR_EOF' > uudconc.pl &&
X#!/usr/local/bin/perl
X#
X#    @(#)uudconc    1.1 - 93/11/19 10:59:04 (FFS)
X#
X# uudconc - a perl uudecoding utility script.
X#
X# This script is used to uudecode files that are all strung together in one
X# long file.  I came up with the idea for the script from my news use - I'm
X# always saving all the binary files into one big news save file (because
X# I'm too lazy to type a new name for each file, and I don't like doing
X# extra work ;-).
X#
X# The only real requirement for this script to work is that the parts of
X# the file be saved in order.  It's really fairly smart as far as "throwing
X# out" extraneous stuff that doesn't belong in the uuencoded file.
X#
X# There aren't a lot in the way of error messages.  As each new file is
X# encountered, it's name is printed out on STDERR.  And error messages are
X# generated if a new file is started before the end statement of the
X# current one, or if an end statement is reached with no beginning
X# statement.
X#
X# Here are the assumptions that I've made about the uuencoded data:
X#
X# o     Lines with lower-case in them are bogus and are thrown out.
X#
X# o     Blank lines are likewise bogus.
X#
X# o     Lines that don't begin with M are bogus, unless they are just
X#       before the end statement.  If supposedly valid lines get that far,
X#       but another valid line beginning with M shows up, the "non-M" lines
X#       are dumped into the bit-bucket.
X#
X# The script is admittedly a bit primitive, but it works well enough for my
X# uses, so I figured that I'd share what I had with anyone who wants it.
X#
X# Credit where credit is due:  This script is losely based on the uudecode
X# sample program on page 198 of the Programming Perl book from O'Reilly.
X# Thank you Larry Wall (and thank you Randal Schwartz)!
X#
X# +----------+-----------------+--------------------------------+-------+
X# |   ^--^   |Rick Schlientz   |Ball Corporation                |   /I  |
X# |   /oo\   |Phn:(619)457-5555|Aerospace & Communications Group|\'o.O' |
X# |  : .  :  |         ext.4272|Telecommunication Products Div. |=(___)=|
X# |   \--/   |FAX:(619)457-5410|Imaging Products                |   U   |
X# | __/\/\__ +-----------------+--------------------------------+       |
X# |/   <>   \|e-mail: rschlientz@ball.com                       |% oop! |
X# ||   ||   ||"Pro is to con as progress is to Congress."       |% awk! |
X# +----------+--------------------------------------------------+-------+
X#------------------------------------------------------------------------------
X# The Program...
X#
X# Loop through the input until you get to the first begin statement, then
X# open the file.
X#
X$_ = <> until ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
Xopen(OUT,"> $file") if $file ne "";
Xwarn "uudecoding $file...";
X#
X# Gotta set up those flags!
X#
X$open_file = 1;
X$near_end = 0;
X$#last_lines = 0;
X#
X# Loop through the rest of the file...
X#
Xwhile (<>) {
X    #
X    # Is this line and end statement?
X    #
X    if (/^end/) {
X        #
X        # Check to see if a file was actually *open* (very
X        # important)...
X        #
X        if ( $open_file == 1 ) {
X            #
X            # Yup!  A file was open, so clean out the attic and
X            # close the sucker down...
X            #
X            if ( $near_end == 1 ) {
X                foreach $closer ( @last_lines ) {
X                    print OUT unpack("u", $closer);
X                }
X                $near_end = 0;
X                $#last_lines = 0;
X            }
X            close(OUT);
X            chmod oct($mode), $file;
X        } else {
X            #
X            # There aren't any files open!  Warn the user, then
X            # blow the sucker off...
X            #
X            warn "Error - file was never opened!";
X        }
X        #
X        # And you *always* gotta reset the flags...
X        #
X        $open_file = 0;
X    }
X    #
X    # Or maybe a begin statement?
X    #
X    if ( /^begin\s*(\d*)\s*(\S*)/ ) {
X        #
X        # Did we ever close the last file?
X        #
X        if ( $open_file == 1 ) {
X            #
X            # Nope!  Let the user know!  Clean out the attic,
X            # and close out the *truncated* file.
X            #
X            warn "Error - file $file was never closed!";
X            if ( $near_end == 1 ) {
X                foreach $closer ( @last_lines ) {
X                    print OUT unpack("u", $closer);
X                }
X                $near_end = 0;
X                $#last_lines = 0;
X            }
X            close(OUT);
X            chmod oct($mode), $file;
X        }
X        #
X        # Ahh... A new beginning!  We'll start fresh with the next
X        # file...
X        #
X        ($mode,$file) = ($1, $2);
X        open(OUT,"> $file") if $file ne "";
X        warn "uudecoding $file...";
X        $open_file = 1;
X    }
X    #
X    # Or maybe it's just plain bogus!
X    #
X    next if /a-z/;
X    next if /^$/;
X    next unless int((((ord() - 32) & 077) + 2) / 3) ==
X        int(length() / 4);
X    #
X    # Well, if we got this far, it *looks* like a valid uuencoded line.
X    # We'll treat it with all the decorum it so richly deserves...
X    #
X    if (/^M/) {
X        #
X        # It's an "M" statement.  If we had any potential
X        # "end-lines" lurking in the eves, time to flush them down
X        # the bit-bucket.
X        #
X        if ( $near_end == 1 ) {
X            $near_end = 0;
X            $#last_lines = 0;
X        }
X        print OUT unpack("u", $_);
X    } else {
X        #
X        # Humm... these may be valid end-lines.  Toss them up in
X        # the attic in case we need them later.
X        #
X        if ( $near_end != 1 ) {
X            $near_end = 1;
X        }
X        push(@last_lines,$_);
X    }
X}
X#
X# Watcha hanging around here for!  We're done, dude!  We can go now!
X#
Xexit 0;
SHAR_EOF
$TOUCH -am 1119114593 uudconc.pl &&
chmod 0555 uudconc.pl ||
echo "restore of uudconc.pl failed"
set `wc -c uudconc.pl`;Wc_c=$1
if test "$Wc_c" != "5776"; then
	echo original size 5776, current size $Wc_c
fi
exit 0
----CUT HERE AND SAVE------------------------------------
---
+------------+-------------------+----------------------------------+---------+
|    ^--^    | Rick Schlientz    | Ball Corporation                 |    /I   |
|    /oo\    | Phn:(619)457-5555 | Aerospace & Communications Group | \'o.O'  |
|   : .  :   |          ext.4272 | Telecommunication Products Div.  | =(___)= |
|    \--/    | FAX:(619)457-5410 | Imaging Products                 |    U    |
|  __/\/\__  +-------------------+----------------------------------+         |
| /   <>   \ | e-mail: rschlientz@ball.com                          | % oop!  |
| |   ||   | | "Pro is to con as progress is to Congress."          | % awk!  |
+------------+------------------------------------------------------+---------+
The ideas expressed here do not necessarily reflect the ideals of Ball or
any of it's subsidiaries...  etc. etc. etc.

-- 
+--------------+----------------------------------------------------+---------+
|     ^--^     | Rick Schlientz - Ball Systems Engineering Division |    /I   |
|     /oo\     |                  VIGS Group  (619) 457-5555 x 4272 | \'o.O'  |
|    : .  :    |                              (619) 457-5410 FAX    | =(___)= |


Article 8402 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:8402
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!xlink.net!scsing.switch.ch!cmir.arnes.si!cathy.ijs.si!matija
From: Matija.Grabnar@ijs.si (Matija Grabnar)
Newsgroups: comp.lang.perl
Subject: Re: uudconc - a perl uudecoding utility for multiple target files.
Message-ID: <1993Nov27.104057.768@cathy.ijs.si>
Date: 27 Nov 93 10:40:57 +0100
References: <2cj9h7$o1b@news.cerf.net>
Followup-To: alt.binaries.pictures.d
Distribution: world
Organization: J. Stefan Institute, Lj, Slovenia
Lines: 22

Your uudconc.pl is very nice, and usefull, but it contains a dangereous
bug. Namely, if the capture file contains text in addition to the uuencoded 
pictures, there may be lines starting with begin which are not proper 
starts of uuencoded files. 

This happened to me - with a long file, so the result were several bogus
files in my directory (like "ning.") which were chmoded to 000. The directory
itself was also somehow chmoded to 000. 

I changed the "match begin" line to read

   /^begin\s*(\d+)\s*(\S+)\s*$/
                ^       ^    ^
Note that this match occurs in the file twice. Change both occurences.

Hope nobody else got bitten by this...
--------------------------------------------------------------------------------
"My name is Not Important. Not to friends. But you can call me mister Important"
     - Not J. Important
Matija.Grabnar@ijs.si                                 A Slovenian and an Atarian
Josef Stefan Inst. Ljubljana     Stefan's law: the highest power in the Universe
                     I speak for no one but myself.


