diff --git a/src/core/MAIN.pm b/src/core/MAIN.pm index 5304e266724..55f6cfb46a7 100644 --- a/src/core/MAIN.pm +++ b/src/core/MAIN.pm @@ -1,87 +1,33 @@ our sub USAGE ($sub=&MAIN) { my @subs = $sub ~~ Multi ?? $sub.candidates !! ($sub); - my @help-msgs = @subs.map( { USAGE-one-sub ($_) } ) ; - return "Usage\n" ~ @help-msgs.join("\nor\n"); -} - -our sub USAGE-one-sub ($sub=&MAIN) { - my $sig = $sub.signature; - my @arguments; - for $sig.params -> $param { - my $argument; - if ($param.named) { - $argument = "--" - ~ $param.name.substr(1) - ~ ($param.type ~~ Bool ?? '' !! "=value-of-{$param.name.substr(1)}") - ; - } else { - $argument = $param.name.substr(1); - if ($param.slurpy) { - $argument ~= " [more [...]]"; - } - } - $argument = "[$argument]" if $param.optional; - @arguments.push($argument); - } - - return ($*PROGRAM_NAME eq '-e' ?? "-e '...'" !! $*PROGRAM_NAME )~ ' ' ~ @arguments.join(' '); - -} - -our sub process-cmd-args(@args is copy, %named) { - my (@positional-arguments, %named-arguments , $negate); - while ( @args ) { - my $passed_value = @args.shift; - if substr($passed_value,0,2) eq '--' { - my $arg = $passed_value.substr(2); - if $arg.match(/^\//) { - $arg .= substr(1) ; - $negate = $arg; - } - - if $arg eq '' { - @positional-arguments.push: @args; - last; - } elsif %named{$arg} ~~ Bool { - %named-arguments{$arg}=True; - } elsif %named{$arg} ~~ Array || ($passed_value.match( /\=/ ) && %named{$arg.split('=', 2)[0]} ~~ Array ) { - if $passed_value.match( /\=/ ) { - my ($name , $value) = $arg.split('=', 2); - if $negate {$negate=$name;} - %named-arguments{$name} = [$value.split(',')]; - } else { - %named-arguments{$arg} = [@args.shift.split(',')]; - } - } elsif $passed_value.match( /\=/ ) { - my ($name , $value) = $arg.split('=', 2); - if $negate {$negate=$name;} - if ($value.match(/^\'.*\'$/) || $value.match(/^\".*\"$/) ) { - %named-arguments{$name} = $value.substr(1,-1); - } elsif $value.match( /.\,./ ) { #--separator=, should not be an array by default but --values=1,2,3 should be - %named-arguments{$name} = [$value.split(',')]; - } else { - %named-arguments{$name} = $value; - } - } elsif $negate { - %named-arguments{$arg} = False; - $negate=''; + + my $USAGE-one-sub = sub ($sub=&MAIN) { + my $sig = $sub.signature; + my @arguments; + for $sig.params -> $param { + my $argument; + if ($param.named) { + $argument = "--" + ~ $param.name.substr(1) + ~ ($param.type ~~ Bool ?? '' !! "=value-of-{$param.name.substr(1)}") + ; } else { - %named-arguments{$arg}=@args.shift; + $argument = $param.name.substr(1); + if ($param.slurpy) { + $argument ~= " [more [...]]"; + } } - } else { - @positional-arguments.push: $passed_value; + $argument = "[$argument]" if $param.optional; + @arguments.push($argument); } + return ($*PROGRAM_NAME eq '-e' ?? "-e '...'" !! $*PROGRAM_NAME )~ ' ' ~ @arguments.join(' '); + }; - if $negate { - %named-arguments{$negate} does False; - $negate = ''; - } - } - - return @positional-arguments, %named-arguments; + + my @help-msgs = @subs.map( { $USAGE-one-sub($_) } ) ; + return "Usage\n" ~ @help-msgs.join("\nor\n"); } - our sub MAIN_HELPER() { my $m = Q:PIR { $P0 = getinterp @@ -97,14 +43,67 @@ our sub MAIN_HELPER() { unless $m { return; } + my $process-cmd-args = sub (@args is copy, %named) { + my (@positional-arguments, %named-arguments , $negate); + while ( @args ) { + my $passed_value = @args.shift; + if substr($passed_value,0,2) eq '--' { + my $arg = $passed_value.substr(2); + if $arg.match(/^\//) { + $arg .= substr(1) ; + $negate = $arg; + } + + if $arg eq '' { + @positional-arguments.push: @args; + last; + } elsif %named{$arg} ~~ Bool { + %named-arguments{$arg}=True; + } elsif %named{$arg} ~~ Array || ($passed_value.match( /\=/ ) && %named{$arg.split('=', 2)[0]} ~~ Array ) { + if $passed_value.match( /\=/ ) { + my ($name , $value) = $arg.split('=', 2); + if $negate {$negate=$name;} + %named-arguments{$name} = [$value.split(',')]; + } else { + %named-arguments{$arg} = [@args.shift.split(',')]; + } + } elsif $passed_value.match( /\=/ ) { + my ($name , $value) = $arg.split('=', 2); + if $negate {$negate=$name;} + if ($value.match(/^\'.*\'$/) || $value.match(/^\".*\"$/) ) { + %named-arguments{$name} = $value.substr(1,-1); + } elsif $value.match( /.\,./ ) { #--separator=, should not be an array by default but --values=1,2,3 should be + %named-arguments{$name} = [$value.split(',')]; + } else { + %named-arguments{$name} = $value; + } + } elsif $negate { + %named-arguments{$arg} = False; + $negate=''; + } else { + %named-arguments{$arg}=@args.shift; + } + } else { + @positional-arguments.push: $passed_value; + } + + if $negate { + %named-arguments{$negate} does False; + $negate = ''; + } + } + + return @positional-arguments, %named-arguments; + }; + my $correct-main-found = False; my @subs = $m ~~ Multi ?? $m.candidates !! ($m); for @subs -> $main { my @named-params = $main.signature.params.grep: {.named && .type ~~ Bool}; my %named-params = @named-params».name».substr(1) Z=> @named-params».type; - my @positional = process-cmd-args(@*ARGS, %named-params); + my @positional = $process-cmd-args(@*ARGS, %named-params); my %named = @positional.pop; - try { + try { $main(|@positional, |%named); $correct-main-found = True; }