USAGE-one-sub and process-cmd-args don't polute the global namespace …

…anymore, USAGE and MAIN_HELPER still do
rakudo · Jun 9, 2010 · 14d1542 · 14d1542
1 parent 6e3624e
commit 14d1542
Showing 1 changed file with 77 additions and 78 deletions.
diff --git 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;
         }