Description: |
usage:
use importopt (namespace=>"NS",
options=>{opt1=>"type",
opt2=>"type[]",
opt3=>"=opt1"});
types: i (integer) /^[+-]?[0-9]+$/
f (float) /^[+-]?[0-9.]+(e[+-]?[0-9]+)?$/
s (string) /./
v (void) /^$/
new types can be defined by simply adding their regexp in %type.
name=>"i[]" will define @NS::name holding all the values for all
instances of --name.
name=>"i" will define $NS::name holding the last given value if there
are multiple instances (no error/warning given).
name=>"=other" will make the option "name" an alias for the option
"other". if "other" is defined to be an array (other=>"i[]"), then
@NS::name will be an alias for @NS::other, else $NS::name will be an
alias for $NS::other. your script won't be able to tell which one
was used on the command line.
options syntaxes (equivalent):
-option[=value]
--option[=value]
if value is ommited, 1 is assumed (for boolean options).
all non-option @ARGV's will be copied to @NS::_args.
if there are any errors (unknown option or invalid value), $NS::_err
will be set to an error code and an error message will be displayed.
error codes:
1: invalid value (didn't match regexp for type)
2: unknown option
3: reference to nonexistent option (aliasing)
|
package importopt;
use strict;
my %type = (i => "^[+-]?[0-9]+\$",
s => ".",
f => "^[+-]?[0-9.]+(e[+-][0-9]+)?\$",
v => "^\$");
sub import (@) {
no strict 'refs';
shift (@_);
my %arg = @_;
if (!defined ($arg {options})) { return(); }
my $ns = $arg {namespace} || "";
my %opt = %{$arg {options}};
my $args = \@{"$ns\::_args"};
my $err = \${"$ns\::_err"};
foreach my $o (keys (%opt)) {
if ($opt{$o} =~ /^([a-zA-Z])(\[\])?$|^=(.*)/) {
my ($t, $a, $r) = ($1 || "", $2 || "", $3 || "");
if ($r) { # option is an alias for another option
unless ($opt{$r}) {
print STDERR ("$o: reference to nonexistent option $r\n");
$$err = 3;
}
$opt{$o} = $opt{$r};
if (defined (@{"$ns\::$r"})) {
*{"$ns\::$o"} = \@{"$ns\::$r"};
} else {
*{"$ns\::$o"} = \${"$ns\::$r"};
}
} else { # assigning twice to avoid "used only once" warning - p
+erhaps not the cleanest solution
if ($a) {
@{"$ns\::$o"} = ();
@{"$ns\::$o"} = ();
} else {
${"$ns\::$o"} = "";
${"$ns\::$o"} = "";
}
$opt{$o} = $t;
}
}
}
@$args = ();
$$err = 0;
while (@ARGV) {
if ($ARGV[0] =~ /^--?(.*?)(?:=(.*))?$/o) {
my ($n, $v) = ($1, $2);
if (defined ($opt{$n})) {
if (($type{$opt{$n}}) && (($v || "") =~ /$type{$opt{$n}}/i)) {
unless (defined ($v)) { $v = ""; }
if (defined (${"$ns\::$n"})) {
${"$ns\::$n"} = $v;
} else {
push (@{"$ns\::$n"}, $v);
}
} else {
print STDERR ("\"$v\": invalid value for $n ($opt{$n})\n");
$$err = 1;
}
} else {
print STDERR ("$n: unknown option\n");
$$err = 2;
}
} else {
push (@$args, $ARGV[0]);
}
shift (@ARGV);
}
@ARGV = @$args;
}
1;
|