From unknown Fri Jul 31 00:39:05 1992
SUB: Table Driven Argument Scanner and Usage Generator (repost)
SUM: vsh@etnibsd.uucp (Steve Harris)->Perl-Users@fuggles.acc.Virginia.EDU

Oops.  One should not post code to the net with less than a week of
regular use.  There was a stupid bug in my script.  Here it is again,
with fixes.

BTW, in response to email from Randal Schwartz (hi Randall; yes, I'm a
compulsive chrome polisher :-)), I should point out that the principal
benefit of my code, relative to the getopt.pl and getopts.pl library
routines, is that it builds a verbose usage summary based on the
information in the @usage_tab table.  Since this is the same info from
which the arguments are parsed, the usage summary is always in sync
with the options scanner.

I find this usage summary (invoked with "-U") quite useful, and
incorporate it in all my scripts.

Caveat emptor:

    not exhaustively tested,

    uses global variables (but, once &parseargs is done, they can be
    reused freely (except, of course, the ones YOU use to store your
    command-line switches)).



=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
#! /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:
#	usage.pl
# This archive created: Fri Jul 17 13:54:50 1992
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'usage.pl'" '(3471 characters)'
if test -f 'usage.pl'
then
	echo shar: "will not over-write existing file 'usage.pl'"
else
sed 's/^	X//' << \SHAR_EOF > 'usage.pl'
	X#!/usr/local/bin/perl
	X
	X# RCS_Id = $Id: usage.perl.mail,v 1.1 2000/03/27 07:34:37 eichin Exp $
	X
	X@prog = split(/\//, $0);
	X$prog = $prog[$#prog];
	X
	X@usage_tab = (
	X    #	opt	arg	action		descrip
	X    #	---	---	------		-------
	X	'v',	'',	'$verbose++',	'verbose',
	X	'd',	'',	'$debug++',	'debug',
	X	'T',	'toc',	'$toc=$arg',	'table of contents for input',
	X	'L',	'list',	'&getlist',	'list of words (delimited with "--")',
	X	'U',	'',	'&usage(1)',	'usage (print this summary)',
	X	'',	'file...',	'',	'files to be processed',
	X);
	X
	X
	X# comment this out if not used
	X$usage_notes = <<EOM;
	X
	XVerbose description of the command goes here.
	XIt should be preceeded and followed with empty lines
	X
	XEOM
	X
	X&parseargs;
	X
	X###--------------------------------------------------------------
	X### diagnostic tests:
	X### To check parseargs, uncomment following lines and do:
	X###	perl usage.pl -Lfoo bar -- -T blah -v
	X###--------------------------------------------------------------
	Xprint "verbose = $verbose\n" if $verbose;
	Xprint "debug = $debug\n" if $debug;
	Xprint "toc = $toc\n" if $toc;
	Xprint "list = @list\n" if @list;
	Xsub getlist {
	X    @list = ($arg);
	X    while (@ARGV) {
	X	$arg = shift(@ARGV);
	X	last if $arg eq '--';
	X	push(@list,$arg);
	X    }
	X}
	X
	X#-----------------------------------------------------------------------------
	X# begin mainline code
	X#-----------------------------------------------------------------------------
	X
	X#-----------------------------------------------------------------------------
	X# utility functions
	X#-----------------------------------------------------------------------------
	X
	Xsub parseargs {
	X    &parse_usage_tab;
	X    ARG:
	X    while ($_ = $ARGV[0], /^-/) {
	X	shift(@ARGV);
	X	last if $_ eq '--';
	X	$n=1;
	X	OPT:
	X	foreach $opt (split(//,$_)) {
	X	    next if $opt eq '-';
	X	    if ($args{$opt} ne '') {
	X		if ($n == length($_)) {
	X		    unless (@ARGV) {
	X			&warn("no arg for option '$opt'");
	X			$err++;
	X			last ARG;
	X		    }
	X		    $arg = shift(@ARGV);
	X		} else {
	X		    $arg = substr($_,$n);
	X		}
	X	    }
	X	    if (defined($acts{$opt})) {
	X		$act = $acts{$opt};
	X		eval($act);
	X		&fatal("cannot eval($act): $@") if $@;
	X	    } else {
	X		&warn("invalid option: $opt");
	X		$err++;
	X	    }
	X	    last OPT if ($args{$opt} ne '');	# remaining opts snarfed into arg
	X	} continue {
	X	    $n++;
	X	}
	X    }
	X    &usage if $err;
	X}
	X
	Xsub parse_usage_tab {
	X    while ($#usage_tab > 0) {
	X	$opt = shift(@usage_tab);
	X	$arg = shift(@usage_tab);
	X	$act = shift(@usage_tab);
	X	$dsc = shift(@usage_tab);
	X	$acts{$opt} = $act;
	X	$args{$opt} = $arg;
	X	$tmp = '';
	X	if ($opt && $arg) {
	X	    $tmp = "-$opt $arg";
	X	    $argopts .= ' ' if $argopts;
	X	    $argopts .= "[$tmp]";
	X	    $usage_desc .= "\t$tmp";
	X	} elsif ($opt) {
	X	    $opts = '-' unless $opts;
	X	    $opts .= $opt;
	X	    $usage_desc .= "\t-$opt";
	X	} elsif ($arg) {
	X	    $tmp = $arg;
	X	    $progargs .= ' ' if $progargs;
	X	    $progargs .= $arg;
	X	    $usage_desc .= "\t$arg";
	X	}
	X	$usage_desc .= "\n\t" if length($tmp) > 7;
	X	$usage_desc .= "\t$dsc" if $dsc;
	X	$usage_desc .= "\n";
	X    }
	X}
	X
	Xsub usage {
	X    print "usage: $prog";
	X    print " [$opts]" if $opts;
	X    print " $argopts" if $opts;
	X    print " $progargs" if $progargs;
	X    print "\n";
	X    exit(1) unless $_[0];
	X    print "where:\n", $usage_desc if $usage_desc;
	X    print $usage_notes if $usage_notes;
	X    exit(1);
	X}
	X
	Xsub warn {
	X	print STDERR $prog, ": warning: ", shift, "\n";
	X	foreach (@_) { print "\t", $_, "\n"; }
	X}
	X
	Xsub fatal {
	X	print STDERR $prog, ": fatal error: ", shift, "\n";
	X	foreach (@_) { print "\t", $_, "\n"; }
	X	exit(-1);
	X}
SHAR_EOF
if test 3471 -ne "`wc -c < 'usage.pl'`"
then
	echo shar: "error transmitting 'usage.pl'" '(should have been 3471 characters)'
fi
fi
exit 0
#	End of shell archive
-- 
... Steve Harris - Eaton Corp. - Beverly, MA - uunet!etnibsd!vsh