NetNews Usenet Archive 1992 #19/NN_1992_19.iso/spool/comp/lang/perl/5490

Text File | 1992-08-25 | 5.8 KB | 180 lines

Newsgroups: comp.lang.perl
Path: sparky!uunet!zaphod.mps.ohio-state.edu!usc!sol.ctr.columbia.edu!destroyer!ubc-cs!dhami
From: [e-mail] (Mandeep S Dhami)
Subject: Even more on fixing #!
Message-ID: <[e-mail]>
Summary: a small script.
Keywords: #!, fixsc
Sender: [e-mail] (Usenet News)
Organization: Computer Science, University of B.C., Vancouver, B.C., Canada
Date: Tue, 25 Aug 92 23:13:00 GMT
Lines: 167

For my word on #!, I use the following script. It is a typical case of a
script, where 10 lines of perl with all the error checking, userful ret.
status, help message and RCS log becomes 100 lines long!

It scans my path for an executable with same name and substitues that
in the #! line. options allow to specify new names, or arbitrary perl
actions on the script name. As sometimes I am playing with my own
copies/newer versions of standard programs, it is useful as it finds
the first such executable on my path (and saves me a
$ perl -i~ -e 's/\#\!\s+oldname/\#\!newname/o if ($.==1)' filename # :-!).
But I will type chmod +x filename(s) anyway, why not fixsc filename(s)
instead.

use fixsc.pl -h for a help message :-)!
shar file appended.

Mandeep.
#------------------8<---- snip ------8<------- snip ----------------
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    fixsc.pl
# This archive created: Tue Aug 25 15:46:21 1992
# By:    Mandeep S Dhami ()
export PATH; PATH=/bin:$PATH
echo shar: extracting "'fixsc.pl'" '(3511 characters)'
if test -f 'fixsc.pl'
then
    echo shar: will not over-write existing file "'fixsc.pl'"
else
sed 's/^X//' << \SHAR_EOF > 'fixsc.pl'
X#!/cs/local/bin/perl -- -*-Perl-*-
X$0=~s!^.*/([^/]+)$!$1!;        # for ps to display the script base name
X                # instead of perl's full path
X#
X# $Author: dhami $
X# Mandeep S Dhami
X# Univ. of BC, Vancouver.
X#
X# You may use it, modify it or sell it
X# (as if!) at your own risk.
X#
X# $RCSfile: fixsc.pl,v $
X# $Revision: 1.1 $
X# $Date: 1992/08/25 22:44:23 $
X#
X# $Log: fixsc.pl,v $
X# Revision 1.1  1992/08/25  22:44:23  dhami
X# Initial revision
X#
X#
X
X$opt="hqi:cxa:n:";
X$usage="$0 [-h][-qc][-i <ext>][-a <action>][-n <interpreter name>] <files>";
X$help="\
XThe Default action:
X      For each filename, if the file begins with an \#\!, $0 finds
X      the base name of the executable specified on that line and if
X      an executable plain file by that name exists on the path, the
X      new name is substituted in \#\! line in corresponding the output
X      file.
X
XThe options:
X  -h  for this help menu
X  -q  quite mode, no error messages,
X      execept in option parsing.
X  -i  make backups with extension <ext>
X      defaults to ~.
X  -c  clobber backups if they exist (paranoid).
X  -a  override the default action specified above and
X      execute <action> on the interpreter name.
X      It should return non zero for success for the
X      warning message/return status to make any sense.
X      (eg: for fixing /usr/bin/perl to /cs/local/bin/perl
X           use 's/^\\/usr/\\/cs\\/local')
X  -n  use the new name <name> for interpreter.
X      overrides option -a <action>.
X  -x  By default $0 changes mode for all files it creates
X      to 0700. -x suppresses this action.
X
XThe return status:
X   0  if no errors
X   n  counts the number of errors it found in fixing
X      all the files.\n\n";
X
X# Defaults
X$opt_i="~";
X$tmp="$0.$$";
X
Xrequire 'getopts.pl';
Xif (! &Getopts($opt)) {&Uerror;}
Xif ($opt_h) {&Help;}
Xif ($#ARGV < $[) {&Warn("No files specified to fix\n"); &Uerror;}
X
X# Initialization
X$opt_n || (@path=split(':',$ENV{'PATH'})); $err=0;
X
Xunlink($tmp);  # Just in case.
Xforeach $i (@ARGV) {
X    &Warn("$i$opt_i exists. Use -c option to clobber\n"), $err++, next
X    if (-f $i.$opt_i && !$opt_c);
X    &Warn("Can not open $i\n"), $err++, next
X    unless (open(FILE,$i));
X    &Warn("$i - does not begin with \#\!\n"), $err++, next
X    unless (($_=<FILE>) && (/^\#\!\s*(\S+)\s+(.*)$/));
X    $name=(defined($opt_n)?$opt_n:$1), $rest=$2;
X    &Warn("Unsuccessful for $name\n"), $err++, next
X    unless (!defined($opt_n) && &Action($name));
X
X    open(OUT,">$tmp") || &Error("Can not open tmp file $tmp\n");
X    print OUT "\#\!$name $rest\n";
X    print OUT $_ while (<FILE>);
X    close OUT;
X    &Warn("Can not rename $i to $i$opt_i\n"), unlink($tmp), $err++, next
X    unless (rename($i,$i.$opt_i));
X    &Warn("Can not make file $i, orignal in $i$opt_i\n"), $err++
X    unless (rename($tmp,$i));
X    unlink($tmp);
X    &Warn("Unable to chmod to 700 for $i\n")
X    unless ($opt_x || chmod 0700, $i);
X}
Xexit $err ;
X
Xsub Action {
X    if (defined($opt_a)) {
X    local($retval); $_=$_[0];
X    $retval=eval $opt_a; $_[0]=$_;
X    &Warn("Error in user-defined action '$opt_a'\n"), return 0  if $@;
X    $retval;
X    }
X    else {
X    $_[0]=~s!^.*\/([^/]+)$!$1!o;
X    foreach (@path) {
X        if (-x "$_/$_[0]" && -r _ && -f _) {
X        $_[0]="$_/$_[0]";
X        return 1;
X        }
X    }
X    0;
X    }
X}
X
Xsub Error  {$opt_q || print STDERR "$0: @_"; exit 1;}
Xsub Warn   {$opt_q || print STDERR "$0: @_"; 0;}
Xsub Uerror {$opt_q || (&Warn("Usage - "), &Usage); exit 1;}
Xsub Usage  {print STDERR "$usage\n"; 1;}
Xsub Help   {print STDERR "USAGE: "; &Usage;
X        print STDERR $help; exit 0;}
X
X# End of file
SHAR_EOF
if test 3511 -ne "`wc -c < 'fixsc.pl'`"
then
    echo shar: error transmitting "'fixsc.pl'" '(should have been 3511 characters)'
fi
chmod +x 'fixsc.pl'
fi # end of overwriting check
#    End of shell archive
exit 0
#------------------8<---- snip ------8<------- snip ----------------
--
__________________________________________________________________
Mandeep S Dhami.                  Tel: Home : 596-3564
11497 87-A Ave.                        Off  : 822-8572
N.Delta, BC.                           Lab  : 822-2895