blob: 143c9aaf8e0bd2c0885505e9f1b93ae203b8d8ea (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
package OpenBSD::Getopt;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(getopts);
sub handle_option
{
my ($opt, $hash, $params) = @_;
$params = 1 unless defined $params;
if (defined $hash->{$opt} and ref($hash->{$opt}) eq 'CODE') {
&{$hash->{$opt}}($params);
} else {
${"opt_$opt"} = $params;
push(@EXPORT, "\$opt_$opt");
$hash->{$opt} = $params;
}
}
sub getopts($;$)
{
my ($args, $hash) = @_;
$hash = {} unless defined $hash;
local @EXPORT;
while ($_ = shift @ARGV) {
last if /^--$/;
unless (m/^-(.)(.*)/s) {
unshift @ARGV, $_;
last;
}
my ($opt, $other) = ($1, $2);
if ($args =~ m/\Q$opt\E(\:)?/) {
if ($1 eq ':') {
if ($other eq '') {
die "no argument for option $opt" unless @ARGV;
$other = shift @ARGV;
}
handle_option($opt, $hash, $other);
} else {
handle_option($opt, $hash);
if ($other ne '') {
$_ = "-$other";
redo;
}
}
} else {
die "Unknown option $opt";
}
}
local $Exporter::ExportLevel = 1;
import OpenBSD::Getopt;
return $hash;
}
1;
|
