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: lm@yallara.cs.rmit.OZ.AU (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: <2bv0hv$3h7@goanna.cs.rmit.oz.au> References: <2bup5g$eof@aggedor.rmit.OZ.AU> Reply-To: zak@rmit.edu.au NNTP-Posting-Host: yallara.cs.rmit.oz.au ralphey@kittyhawk.aero.rmit.OZ.AU (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, # 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 () { 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<