Article 7868 of comp.lang.perl:

Article 7868 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:7868
Path: feenix.metronet.com!news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!howland.reston.ans.net!spool.mu.edu!caen!batcomputer!munnari.oz.au!goanna.cs.rmit.oz.au!yallara!lm
From: [email protected] (Luke Mewburn)
Newsgroups: comp.lang.perl
Subject: Re: unshar and file writing.
Date: 12 Nov 1993 03:39:43 GMT
Organization: Technical Support Group, Dept. of Computer Science, RMIT
Lines: 145
Message-ID: <[email protected]>
References: <[email protected]>
Reply-To: [email protected]
NNTP-Posting-Host: yallara.cs.rmit.oz.au

[email protected] (Russell Alphey) writes:

> I have 2 questions to ask of the PERL experts out there. I've just started
> using Perl, and want to use it to UNSHAR usenet source files. The unshar I
> got from the coombs archive site always barfs on my source files, yet
> running the '.r' file created always produces sensible files. Has anybody
> created a better version of unshar, or alternately can point me to any other
> sort of unshar?

Yep, I've attached my perl version. Can grok gzipped/compressed
articles (great for shar parts of comp.sources.* archives), and with
the appropriate options, do the work in a subdir (for those who shar
stuff in the `root' level), and generate nn style Unshar.{Headers,Results}
files.

Luke.

--- cut here --- file: /usr/local/bin/unsh
#!/usr/bin/perl
#
# Unshar the given files. Correctly handles compressed/packed/gzipped
# files (if gzip is present on the system), and recognizes the most
# common shar headers.
#
# Usage: unsh [-d] [-v] [-h] file [...]
# -d create directory of form file.UNSH to extract into
# -v invoke /bin/sh with -x (for verbosity)
# -h create Unsh.headers & Unsh.result files
#
# Written 930621 by Luke Mewburn, <[email protected]>
# History:
# v1.1: Added -h & child process for /bin/sh (about 10 minutes later:)
# v1.0: Initial version

require "getopts.pl";

$progname = $0;
$progname =~ s/.*\/([^\/]+)/$1/;
$shellcmd = "/bin/sh";

&Getopts('dvh') || &usage;
if ($opt_d) { $makedir = 1; }
if ($opt_v) { $verbose = 1; $shellcmd .= " -x"; }
if ($opt_h) { $headers = 1; }
&usage unless @ARGV;

$curdir = ".";

MAIN:
while (@ARGV) {
# incase previous file took us away from .
chdir($curdir) || die "$progname: Can't chdir to $curdir - $!";
$curdir = ".";

$file = shift @ARGV;
print ">> Un-Sharing: ", $file, "\n";
# if ($file =~ /\..*[zZ]$/) {
if ($file =~ /.*\.g?[zZ]$/) {
if (!open(SHARFIL, "gzip -dc $file |")) {
print "$progname: Can't gunzip $file - $!.\n";
next MAIN;
}
} else {
if (!open(SHARFIL, $file)) {
print "$progname: Can't open $file - $!.\n" ;
next MAIN;
}
}

$dir = "";
if ($makedir) {
$dir = $file;
$dir =~ s/.*\/([^\/]+)/$1/;
$dir =~ s/([^\.]+)\..*/$1/;
$dir .= ".UNSH";

if (!mkdir($dir, 0700)) {
print "$progname: Can't mkdir $dir - $!.\n";
next MAIN;
}
if (!chdir($dir)) {
print "$progname: Can't chdir $dir - $!.\n";
next MAIN;
}
$curdir = "..";
}

if ($headers) {
if (!open(HEADER, ">> Unsh.headers")) {
print "$progname: Can't open Unsh.headers - $!\n";
next MAIN;
}
print HEADER "File: $file\n";
}

while (<SHARFIL>) {
last if m|^#!/bin/sh|;
last if m|^#! /bin/sh|;
last if m|This is a shell archive|;
$headers && print HEADER;
}
$headers && print HEADER "\n";
close(HEADER);
if (eof(SHARFIL)) {
print "$progname: Got eof before shell magic.\n" if (eof(SHARFIL));
next MAIN;
}

print ">> extracting to ./", $dir, "\n";
if (open(PIPESH, "|-") == 0) { # child
if ($headers) {
open(STDOUT, "| tee -a Unsh.result") ||
die ("$progname: Child can't tee to Unsh.result - $!");
}
exec $shellcmd;
}

while (read(SHARFIL, $buf, 4096)) {
print PIPESH $buf;
}
close PIPESH;
if ($?) {
print "$progname: sh died with exit val $?.\n";
next MAIN;
}
}

exit;

#
# usage --
# print the usage and exit
#
sub usage
{
print<<USAGE;
Usage: $progname [-d] [-h] [-v] file [...]
-d create a directory of the form 'file.UNSH' to extract into
-h create Unsh.headers & Unsh.result files
-v invoke /bin/sh with -x (for verbosity)
USAGE
exit 1;
}
--- cut here ---