This is cmdparse.pl in view mode; [Download] [Up]
#########################################################################
# ^FILE: cmdparse.pl - cmdparse for perl programs
#
# ^DESCRIPTION:
# This file defines a perl function named cmdparse to parse
# command-line arguments for perl scripts.
#
# ^HISTORY:
# 05/14/91 Brad Appleton <brad@ssd.csd.harris.com> Created
##^^#####################################################################
########
# ^FUNCTION: cmdparse - parse command-line argument vectors
#
# ^SYNOPSIS:
# eval &cmdparse(@args);
#
# ^PARAMETERS:
# args -- The vector of arguments to pass to cmdparse(1);
# This will usually be the list ("-decls=$ARGS", "--", $0, @ARGV)
# where $ARGS is the variable containing all the argument
# declaration strings.
#
# ^DESCRIPTION:
# Cmdparse will invoke cmdparse(1) to parse the command-line.
#
# ^REQUIREMENTS:
# Any desired initial values for variables from the argument-description
# string should be assigned BEFORE calling this function.
#
# ^SIDE-EFFECTS:
# Terminates perl-script execution if command-line syntax errors are found
#
# ^RETURN-VALUE:
# A string of perl-variable settings to be evaluated.
#
# ^EXAMPLE:
# #!/usr/bin/perl
#
# require 'cmdparse.pl';
#
# $ARGS = '
# ArgStr string "[S|Str string]" : STICKY "optional string argument"
# ArgStr groups "[g|groups newsgroups ...]" "groups to test"
# ArgInt count "[c|count number]" "group repeat count"
# ArgStr dirname "[d|directory pathname]" "directory to use"
# ArgBool xflag "[x|xmode]" "turn on X-mode"
# ArgClear yflag "[y|ymode]" "turn off Y-mode"
# ArgChar sepch "[s|separator char]" "field separator"
# ArgStr files "[f|files filenames ...]" "files to process"
# ArgStr name "[n|name] name" "name to use"
# ArgStr ARGV "[args ...]" "any remaining arguments"
# ';
#
# $count = 1;
# $dirname = '.';
# $sepch = ',';
# $yflag = 'TRUE';
#
# eval &cmdparse("-decls=$ARGS", "--", $0, @ARGV);
#
##^^####
sub cmdparse {
local(@args) = @_ ;
local($output) = ("");
local($nforks, $tmpfile, $tmpdir, $exitrc, $_) = (0, "tmp$$");
$tmpdir = $ENV{'TMP'}; ## use ${TMP:-/tmp}/tmp$$ as the temporary file
if (! $tmpdir) {
$tmpdir = '/tmp';
}
$tmpfile = $tmpdir . '/' . $tmpfile;
## I could just call cmdparse(1) using `cmdparse <options> <args>`
## but then I would need to escape all shell meta-characters in each
## argument. By using exec(), the arguments are passed directly to
## the system and are not "globbed" or expanded by the shell.
##
## Hence I will need to fork off a child, redirect its standard output
## to a temporary file, and then exec cmdparse(1).
FORK: {
++$nforks;
if ($pid = fork) {
# parent here
waitpid($pid, 0); ## wait for child to die
$exitrc = $?;
$output = `cat $tmpfile` unless $exitrc; ## save the output-script
unlink($tmpfile); ## remove the temporary file
if ($exitrc) {
$! = 0;
die "\n";
}
} elsif (defined $pid) { ## pid is zero here if defined
# child here
open(STDOUT, "> $tmpfile") || die "Can't redirect stdout";
exec("cmdparse", "-shell=perl", @args);
} elsif ($! =~ /No more process/ ) {
# EAGAIN, supposedly recoverable fork error
if ($nforks > 10) {
die "$0: Can't fork cmdparse(1) after 10 tries.\n" ;
} else {
sleep 1;
redo FORK;
}
} else {
die "$0: Can't fork cmdparse(1): $!\n" ;
}
} ##FORK
return $output;
}
1;
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.