Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

293 lines (238 sloc) 8.943 kb
=begin
=head1 NAME
HLL::CommandLine - command line parsing tools
=head1 SYNOPSIS
my $parser := HLL::CommandLine::Parser.new([
'verbose',
'target=s',
'e=s'
]);
# treat the first non-option argument as the program name,
# and everything after that as arguments to the program
$parser.stop-after-first-arg;
# -e "program" also treats everything after it as arguments
# to the program:
$paser.add-stopper('-e');
my $results := $parser.parse(@*ARGS);
my %options := $parser.options;
my @args := $pasre.arguments; # remaining arguments from @*ARGS
=head1 DESCRIPTION
HLL::CommandLine::Parser stores a specification of command line options and
other behavior, and uses that to parse an array of command line directives.
It classifies the directives as I<options> (usually of the form C<-f> or
C<--foo>) and I<arguments> (ie. non-options). The result of a C<.parse(RPA)>
call is an C<HLL::CommandLine::Result> object (or an exception thrown),
which makes the options and arguments available via the methods C<options>
and C<arguments>.
=head1 HLL::CommandLine::Parser
=head2 new(Array)
The C<.new> method and constructor expects an array with option specifications.
Such a specification is the name of an option, optionally followed by the
C<=> equals sign and a single character describing the kind of value it expects.
Missing value specification or C<b> stand for C<bool>, ie the option does not
expect a value. C<s> stands for a string value.
Optional values are only supported for string values so far. For the
value specified with C<s?> the value will default to ''.
=head2 add-stopper(String)
Adds a stopper. A stopper is a special value that, when encountered in the
command line arguments, terminates the processing, and classifies the rest
of the strings as arguments, independently of their form. C<--> is a
pre-defined stopper. If an option is used a stopper, that option itself is
still processed.
Examples:
yourprogram -a --bar b -- c --foo
# options: a = 1, bar = 1
# arguments: b, c, --foo
# with stopper -e, and -e expecting a value:
yourprogram -a -e foo --bar baz
# options: -a = 1, -e = foo
# arguments: --bar, baz
=head2 parse(Array)
Parses the array as command line strings, and returns a
C<HLL::CommandLine::Result> object (or thrown an exception on error).
=head1 HLL::CommandLine::Result
An object of this type holds the options and arguments from a successful
command line parse.
=head2 options
Returns a hash of options
=head2 arguments
Return an array of arguments.
=end
=cut
class HLL::CommandLine::Result {
has @!arguments;
has %!options;
method init() {
@!arguments := [];
%!options := nqp::hash();
}
method arguments() { @!arguments }
method options() { %!options }
method add-argument($x) {
nqp::push(@!arguments, $x);
}
method add-option($name, $value) {
# how I miss p6's Hash.push
if nqp::existskey(%!options, $name) {
if pir::does(%!options{$name}, 'array') {
nqp::push(%!options{$name}, $value);
} else {
%!options{$name} := [ %!options{$name}, $value ];
}
} else {
%!options{$name} := $value;
}
}
}
class HLL::CommandLine::Parser {
has @!specs;
has %!options;
has %!stopper;
has $!stop-after-first-arg;
method new(@specs) {
my $obj := self.CREATE;
$obj.BUILD(specs => @specs);
$obj;
}
method stop-after-first-arg() {
$!stop-after-first-arg := 1;
}
method BUILD(:@specs) {
%!stopper{'--'} := 1;
$!stop-after-first-arg := 0;
for @specs {
self.add-spec($_);
}
}
method add-stopper($x) {
%!stopper{$x} := 1;
}
method split-option-aliases($s) {
nqp::split('|', $s);
}
method add-spec($s) {
my $i := nqp::index($s, '=');
my $type;
my @options;
if $i < 0 {
$type := 'b';
@options := self.split-option-aliases($s);
} else {
$type := nqp::substr($s, $i + 1);
@options := self.split-option-aliases(nqp::substr($s, 0, $i));
}
for @options {
%!options{$_} := $type;
}
}
method is-option($x) {
return 0 if $x eq '-' || $x eq '--';
return 1 if nqp::substr($x, 0, 1) eq '-';
0;
}
method wants-value($x) {
my $spec := %!options{$x};
nqp::substr($spec, 0, 1) eq 's';
}
method optional-value($x) {
my $spec := %!options{$x};
$spec eq 's?';
}
method parse(@args) {
my $i := 0;
my $arg-count := +@args;
my $result := HLL::CommandLine::Result.new();
$result.init();
# called when an option expects a value after it
sub get-value($opt) {
if $i == $arg-count - 1 {
nqp::die("Option $opt needs a value");
} elsif self.is-option(@args[$i + 1]) {
nqp::die("Option $opt needs a value, but is followed by an option");
} elsif %!stopper{@args[$i + 1]} {
nqp::die("Option $opt needs a value, but is followed by a stopper");
} else {
$i++;
@args[$i];
}
}
# called after a terminator that declares the rest
# as not containing any options
sub slurp-rest() {
$i++;
while $i < $arg-count {
$result.add-argument(@args[$i]);
$i++;
}
}
while $i < $arg-count {
my $cur := @args[$i];
if self.is-option($cur) {
if nqp::substr($cur, 0, 2) eq '--' {
# long option
my $opt := nqp::substr(@args[$i], 2);
my $idx := nqp::index($opt, '=');
my $value := 1;
my $has-value := 0;
if $idx >= 0 {
$value := nqp::substr($opt, $idx + 1);
$opt := nqp::substr($opt, 0, $idx);
$has-value := 1;
} elsif self.optional-value($opt) {
$value := '';
$has-value := 1;
}
nqp::die("Illegal option --$opt") unless nqp::existskey(%!options, $opt);
nqp::die("Option --$opt does not allow a value") if !self.wants-value($opt) && $has-value;
if !$has-value && self.wants-value($opt) {
$value := get-value("--$opt");
}
$result.add-option($opt, $value);
slurp-rest if %!stopper{"--$opt"};
} else {
my $opt := nqp::substr($cur, 1);
my $len := nqp::chars($opt);
if $len == 1 {
# not grouped, so it might have a value
nqp::die("No such option -$opt") unless %!options{$opt};
if self.wants-value($opt) {
$result.add-option($opt,
get-value("-$opt"));
} else {
$result.add-option($opt, 1);
}
slurp-rest() if %!stopper{"-$opt"};
} else {
my $i := 0;
while $i < $len {
my $o := nqp::substr($opt, $i, 1);
if %!options{$o} {
if self.wants-value($o) {
if $i + 1 == $len {
nqp::die("Option '$o' in grouped options '-$opt' needs a value, but does not have one");
}
$result.add-option($o, nqp::substr($opt, $i + 1));
last;
}
else {
$result.add-option($o, 1);
}
}
else {
nqp::die("Grouped options '-$opt' contain '$o', which is not a valid option")
}
$i++;
}
}
}
} elsif %!stopper{$cur} {
slurp-rest();
} else {
$result.add-argument($cur);
slurp-rest() if $!stop-after-first-arg;
}
$i++;
}
return $result;
}
}
Jump to Line
Something went wrong with that request. Please try again.