Category: | CLI modules |
Author/Contact Info | lanzz <lanzz@graffiti.net> |
Description: | usage: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;
|
Back to
Code Catacombs