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.