Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

281 lines (226 sloc) 8.344 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 := pir::new('Hash');
}
method arguments() { @!arguments }
method options() { %!options }
method add-argument($x) {
pir::push__vPP(@!arguments, $x);
}
method add-option($name, $value) {
# how I miss p6's Hash.push
if pir::exists(%!options, $name) {
my $t := pir::typeof(%!options);
say($t);
if $t eq 'ResizablePMCArray' {
pir::push(%!options{$name}, $value);
} else {
%!options{$name} := [ %!options{$name}, $name ];
}
} 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) {
pir::split('|', $s);
}
method add-spec($s) {
my $i := pir::index($s, '=');
my $type;
my @options;
if $i < 0 {
$type := 'b';
@options := self.split-option-aliases($s);
} else {
$type := pir::substr($s, $i + 1);
@options := self.split-option-aliases(pir::substr($s, 0, $i));
}
for @options {
%!options{$_} := $type;
}
}
method is-option($x) {
return 0 if $x eq '-' || $x eq '--';
return 1 if pir::substr($x, 0, 1) eq '-';
0;
}
method wants-value($x) {
my $spec := %!options{$x};
pir::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 {
pir::die("Option $opt needs a value");
} elsif self.is-option(@args[$i + 1]) {
pir::die("Option $opt needs a value, but is followed by an option");
} elsif %!stopper{@args[$i + 1]} {
pir::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 pir::substr($cur, 0, 2) eq '--' {
# long option
my $opt := pir::substr(@args[$i], 2);
my $idx := pir::index($opt, '=');
my $value := 1;
my $has-value := 0;
if $idx >= 0 {
$value := pir::substr($opt, $idx + 1);
$opt := pir::substr($opt, 0, $idx);
$has-value := 1;
} elsif self.optional-value($opt) {
$value := '';
$has-value := 1;
}
pir::die("Illegal option --$opt") unless pir::exists(%!options, $opt);
pir::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 := pir::substr($cur, 1);
if pir::length($opt) == 1 {
# not grouped, so it might have a value
pir::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 {
# length > 1, so the options are grouped
my $iter := pir::iter__pp($opt);
while $iter {
my $o := pir::shift($iter);
pir::die("Option -$o requires a value and cannot be grouped") if self.wants-value($o);
$result.add-option($o, 1);
}
}
}
} 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.