sub getopts ($;$) { my ($argumentative, $hash) = @_; my (@args,$first,$rest,$exit); my $errs = 0; local $_; local @EXPORT; @args = split( / */, $argumentative ); while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/s) { ($first,$rest) = ($1,$2); if (/^--$/) { # early exit if -- shift @ARGV; last; } my $pos = index($argumentative,$first); if ($pos >= 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 { ${"opt_$first"} = $rest; push( @EXPORT, "\$opt_$first" ); } } else { if (ref $hash) { $$hash{$first} = 1; } else { ${"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); } }