FILE: C:\Program Files (x86)\Plesk\perl\lib\Getopt\Std.pm

--
package Getopt::Std;

use strict;
use warnings;

require Exporter;

=head1 NAME

Getopt::Std - Process single-character switches with switch clustering

=head1 SYNOPSIS

    use Getopt::Std;

    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
		      # Sets $opt_* global variables as a side effect
    getopts('oif:', \my %opts);  # Options as above, values in %opts
    getopt('oDI');    # -o, -D & -I take arguments
                      # Sets $opt_* global variables as a side effect
    getopt('oDI', \my %opts);    # -o, -D & -I take arg, values in %opts

=head1 DESCRIPTION

The C function processes single-character switches with switch
clustering.  Pass one argument which is a string containing all switches to be
recognized.  For each switch found, if an argument is expected and provided,
C sets C<$opt_x> (where C is the switch name) to the value of
the argument.  If an argument is expected but none is provided, C<$opt_x> is
set to an undefined value.  If a switch does not take an argument, C<$opt_x>
is set to C<1>.

Switches which take an argument don't care whether there is a space between
the switch and the argument.  If unspecified switches are found on the
command-line, the user will be warned that an unknown option was given.

The C function returns true unless an invalid option was found.

The C function is similar, but its argument is a string containing
all switches that take an argument.  If no argument is provided for a switch,
say, C, the corresponding C<$opt_y> will be set to an undefined value.
Unspecified switches are silently accepted.  Use of C is B.

Note that, if your code is running under the recommended C pragma, you will need to declare these package variables
with C:

    our($opt_x, $opt_y);

For those of you who don't like additional global variables being created,
C and C will also accept a hash reference as an optional
second argument.  Hash keys will be C (where C is the switch name) with
key values the value of the argument or C<1> if no argument is specified.

To allow programs to process arguments that look like switches, but aren't,
both functions will stop processing switches when they see the argument
C<-->.  The C<--> will be removed from C<@ARGV>.

=head1 C<--help> and C<--version>

If C<-> is not a recognized switch letter, C supports arguments
C<--help> and C<--version>.  If C and/or
C are defined, they are called; the arguments are
the output file handle, the name of option-processing package, its version,
and the switches string.  If the subroutines are not defined, an attempt is
made to generate intelligent messages; for best results, define C<$main::VERSION>.

If embedded documentation (in pod format, see L) is detected
in the script, C<--help> will also show how to access the documentation.

Note that due to excessive paranoia, if C<$Getopt::Std::STANDARD_HELP_VERSION>
isn't true (the default is false), then the messages are printed on C,
and the processing continues after the messages are printed.  This being
the opposite of the standard-conforming behaviour, it is strongly recommended
to set C<$Getopt::Std::STANDARD_HELP_VERSION> to true.

One can change the output file handle of the messages by setting
C<$Getopt::Std::OUTPUT_HELP_VERSION>.  One can print the messages of C<--help>
(without the C line) and C<--version> by calling functions C
and C with the switches string as an argument.

=cut

our @ISA = qw(Exporter);
our @EXPORT = qw(getopt getopts);
our $VERSION = '1.14';
# uncomment the next line to disable 1.03-backward compatibility paranoia
# $STANDARD_HELP_VERSION = 1;

# Process single-character switches with switch clustering.  Pass one argument
# which is a string containing all switches that take an argument.  For each
# switch found, sets $opt_x (where x is the switch name) to the value of the
# argument, or 1 if no argument.  Switches which take an argument don't care
# whether there is a space between the switch and the argument.

# Usage:
#	getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.

sub getopt (;$$) {
    my ($argumentative, $hash) = @_;
    $argumentative = '' if !defined $argumentative;
    my ($first, $rest);
    local $_;
    local @EXPORT;

    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
	($first, $rest) = ($1, $2);
	if (/^--$/) {	# early exit if --
	    shift @ARGV;
	    last;
	}
	if (index($argumentative, $first) >= 0) {
	    if ($rest ne '') {
		shift(@ARGV);
	    }
	    else {
		shift(@ARGV);
		$rest = shift(@ARGV);
	    }
	    if (ref $hash) {
	        $$hash{$first} = $rest;
	    }
	    else {
            no strict 'refs';
	        ${"opt_$first"} = $rest;
	        push( @EXPORT, "\$opt_$first" );
	    }
	}
	else {
	    if (ref $hash) {
	        $$hash{$first} = 1;
	    }
	    else {
            no strict 'refs';
	        ${"opt_$first"} = 1;
	        push( @EXPORT, "\$opt_$first" );
	    }
	    if ($rest ne '') {
		$ARGV[0] = "-$rest";
	    }
	    else {
		shift(@ARGV);
	    }
	}
    }
    unless (ref $hash) { 
	local $Exporter::ExportLevel = 1;
	Getopt::Std->import;
    }
}

our ($OUTPUT_HELP_VERSION, $STANDARD_HELP_VERSION);
sub output_h () {
  return $OUTPUT_HELP_VERSION if defined $OUTPUT_HELP_VERSION;
  return \*STDOUT if $STANDARD_HELP_VERSION;
  return \*STDERR;
}

sub try_exit () {
    exit 0 if $STANDARD_HELP_VERSION;
    my $p = __PACKAGE__;
    print {output_h()} <= 5.006;
	print $h <) {
		$has_pod = 1, last if /^=(pod|head1)/;
	    }
	}
	print $h <= 0) {
	    if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
		shift(@ARGV);
		if ($rest eq '') {
		    ++$errs unless @ARGV;
		    $rest = shift(@ARGV);
		}
		if (ref $hash) {
		    $$hash{$first} = $rest;
		}
		else {
            no strict 'refs';
		    ${"opt_$first"} = $rest;
		    push( @EXPORT, "\$opt_$first" );
		}
	    }
	    else {
		if (ref $hash) {
		    $$hash{$first} = 1;
		}
		else {
            no strict 'refs';
		    ${"opt_$first"} = 1;
		    push( @EXPORT, "\$opt_$first" );
		}
		if ($rest eq '') {
		    shift(@ARGV);
		}
		else {
		    $ARGV[0] = "-$rest";
		}
	    }
	}
	else {
	    if ($first eq '-' and $rest eq 'help') {
		version_mess($argumentative, 'main');
		help_mess($argumentative, 'main');
		try_exit();
		shift(@ARGV);
		next;
	    } elsif ($first eq '-' and $rest eq 'version') {
		version_mess($argumentative, 'main');
		try_exit();
		shift(@ARGV);
		next;
	    }
	    warn "Unknown option: $first\n";
	    ++$errs;
	    if ($rest ne '') {
		$ARGV[0] = "-$rest";
	    }
	    else {
		shift(@ARGV);
	    }
	}
    }
    unless (ref $hash) { 
	local $Exporter::ExportLevel = 1;
	Getopt::Std->import;
    }
    $errs == 0;
}

1;

--