require 5.000;
require Exporter;
+=head1 NAME
+
+getopt - Process single-character switches with switch clustering
+
+getopts - Process single-character switches with switch clustering
+
+=head1 SYNOPSIS
+
+ use Getopt::Std;
+
+ getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
+ getopt('oDI', \%opts); # -o, -D & -I take arg. Values in %opts
+ getopts('oif:'); # -o & -i are boolean flags, -f takes an argument
+ # Sets opt_* as a side effect.
+ getopts('oif:', \%opts); # options as above. Values in %opts
+
+=head1 DESCRIPTION
+
+The getopt() functions processes 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.
+
+For those of you who don't like additional variables being created, getopt()
+and getopts() will also accept a hash reference as an optional second argument.
+Hash keys will be x (where x is the switch name) with key values the value of
+the argument or 1 if no argument is specified.
+
+=cut
+
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
# Usage:
# getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
-sub getopt {
- local($argumentative) = @_;
+sub getopt ($;$) {
+ local($argumentative, $hash) = @_;
local($_,$first,$rest);
local $Exporter::ExportLevel;
shift(@ARGV);
$rest = shift(@ARGV);
}
- eval "\$opt_$first = \$rest;";
- push( @EXPORT, "\$opt_$first" );
+ if (ref $hash) {
+ $$hash{$first} = $rest;
+ }
+ else {
+ eval "\$opt_$first = \$rest;";
+ push( @EXPORT, "\$opt_$first" );
+ }
}
else {
- eval "\$opt_$first = 1;";
- push( @EXPORT, "\$opt_$first" );
+ if (ref $hash) {
+ $$hash{$first} = 1;
+ }
+ else {
+ eval "\$opt_$first = 1;";
+ push( @EXPORT, "\$opt_$first" );
+ }
if ($rest ne '') {
$ARGV[0] = "-$rest";
}
# getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
# # side effect.
-sub getopts {
- local($argumentative) = @_;
+sub getopts ($;$) {
+ local($argumentative, $hash) = @_;
local(@args,$_,$first,$rest);
local($errs) = 0;
local $Exporter::ExportLevel;
($first,$rest) = ($1,$2);
$pos = index($argumentative,$first);
if($pos >= 0) {
- if($args[$pos+1] eq ':') {
+ if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
shift(@ARGV);
if($rest eq '') {
++$errs unless @ARGV;
$rest = shift(@ARGV);
}
- eval "\$opt_$first = \$rest;";
- push( @EXPORT, "\$opt_$first" );
+ if (ref $hash) {
+ $$hash{$first} = $rest;
+ }
+ else {
+ eval "\$opt_$first = \$rest;";
+ push( @EXPORT, "\$opt_$first" );
+ }
}
else {
- eval "\$opt_$first = 1";
- push( @EXPORT, "\$opt_$first" );
+ if (ref $hash) {
+ $$hash{$first} = 1;
+ }
+ else {
+ eval "\$opt_$first = 1";
+ push( @EXPORT, "\$opt_$first" );
+ }
if($rest eq '') {
shift(@ARGV);
}