Changeset 173

Show
Ignore:
Timestamp:
07/07/04 01:50:51 (4 years ago)
Author:
athomas
Message:

Fixed some bugs were the context was not being returned from CLI::parse.

Added a VALIDATE target, which can be used to enforce specific input values.
This differs from HELP in that the HELP target is merely informational.
The VALIDATE target must be a subroutine and must return a true value for
successful validation and false for failure. Differs slightly from ACTION or
HELP in that the second argument is the argument it is validating. All further
arguments are tracked arguments from the grammar.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • manage/trunk/CLI/Context.pm

    r171 r173  
    1313                $self->{$key} = $args{$key}; 
    1414        } 
     15my @tmp = @{$self->{tokens}}; 
     16        $self->{all_tokens} = \@tmp; 
    1517        push(@{$self->{grammar_history}}, $self->{grammar}); 
    1618        return $self; 
     19} 
     20 
     21sub all_tokens() { 
     22my $self = shift; 
     23 
     24        return $self->{all_tokens}; 
    1725} 
    1826 
    …… 
    2533} 
    2634 
    27 sub current_grammar($) { 
     35sub grammar_history() { 
     36my $self = shift; 
     37 
     38        return $self->{grammar_history}; 
     39} 
     40 
     41sub token_history() { 
     42my $self = shift; 
     43 
     44        return $self->{token_history}; 
     45} 
     46 
     47sub current_grammar() { 
    2848my $self = shift; 
    2949 

  • manage/trunk/CLI.pm

    r172 r173  
    6464                                        } else { 
    6565                                                $| = 1; 
    66                                                 print("\e[1m\e[31mCLI plugin '$file' error:\e[22m\n" . $format->format($@) . "\e[0m"); 
     66                                                print(STDERR "\e[1m\e[31mCLI plugin '$file' error:\e[22m\n" . $format->format($@) . "\e[0m"); 
    6767                                                $| = 0; 
    6868                                        } 
    …… 
    126126 
    127127                # Trailing tokens after help 
    128                 return ('ERROR', 'Trailing tokens after ?') if $ctx->more_tokens(); 
     128                return ('ERROR', 'Trailing tokens after ?', $ctx) if $ctx->more_tokens(); 
    129129 
    130130                # Construct help string 
    …… 
    190190                $help .= "\n" if $cmd->{HELPFOOTER} or $cmd->{HELPHEADER}; 
    191191                $help .= $cmd->{HELPFOOTER} . "\n" if $cmd->{HELPFOOTER}; 
    192                 return ('ERROR', 'No help available.') unless defined($help) and $help ne ''; 
    193                 return ('HELP', $help); 
     192                return ('ERROR', 'No help available.', $ctx) unless defined($help) and $help ne ''; 
     193                return ('HELP', $help, $ctx); 
    194194        } 
    195195 
    …… 
    211211                                if ($ac =~ /^[A-Z]+$/) { 
    212212                                        if ($rhs) { 
    213                                                 +1; 
     213                                                -1; 
    214214                                        } else { 
    215215                                                $ac cmp $bc; 
    …… 
    217217                                } elsif ($bc =~ /^[A-Z]+$/) { 
    218218                                        if ($lhs) { 
    219                                                 -1; 
     219                                                +1; 
    220220                                        } else { 
    221221                                                $ac cmp $bc; 
    …… 
    268268 
    269269                                if ($type eq 'HASH') { 
     270                                        # Do validation 
     271                                        if ($cmd->{$key}->{VALIDATE}) { 
     272                                                return ('ERROR', "Invalid input '$token'.", $ctx) 
     273                                                        unless $cmd->{$key}->{VALIDATE}->($ctx, $token, @{$ctx->args()}); 
     274                                        } 
     275 
    270276                                        $ctx->inject_token($token) if $rx eq 'ACTION'; 
    271277                                        return $self->parse_node($ctx->next_grammar($cmd->{$key})); 
    …… 
    275281                                                return ('HELP', "\e[32m\e[1mOK Command is complete.\e[0m\n") 
    276282                                                        if $ctx->peek_token() eq '?'; 
    277                                                 return ('ERROR', "Trailing tokens: '" . join(" ", $ctx->more_tokens()) . "' (possibly missing help?).") 
     283                                                return ('ERROR', "Trailing tokens: '" . join(" ", $ctx->more_tokens()) . "' (possibly missing help?).", $ctx) 
    278284                                        } 
    279285                                        return ('ACTION', $cmd->{$key}, $ctx); 
    280286                                } else { 
    281                                         return ('ERROR', 'Invalid terminal node, should be CODE or HASH.'); 
    282                                 } 
    283                         } 
    284                 } 
    285         } 
    286         return ('ERROR', 'More input expected.') unless defined($token); 
     287                                        return ('ERROR', 'Invalid terminal node, should be CODE or HASH.', $ctx); 
     288                                } 
     289                        } 
     290                } 
     291        } 
     292        return ('ERROR', 'More input expected.', $ctx) unless defined($token); 
    287293        if ($cmd->{ERROR}) { 
    288294        my $error = $cmd->{ERROR}; 
    289295 
    290296                $error =~ s/\${ARG}/$token/g; 
    291                 return ('ERROR', $error); 
     297                return ('ERROR', $error, $ctx); 
    292298        } else { 
    293299                if (defined($token)) { 
    …… 
    303309                                        push(@candidates, $cp); 
    304310                                } 
    305                                 return ('ERROR', "No unique candidates for '$token', candidates are '@candidates'") 
    306                         } 
    307                 } 
    308                 return ('ERROR', "Unrecognized command '$token'."); 
     311                                return ('ERROR', "No unique candidates for '$token', candidates are '@candidates'", $ctx) 
     312                        } 
     313                } 
     314                return ('ERROR', "Unrecognized command '$token'.", $ctx); 
    309315        } 
    310316} 

  • manage/trunk/manage

    r172 r173  
    1717use Text::Table; 
    1818use POSIX qw(ctermid); 
     19 
     20use constant CMD_ARG => 1; 
     21use constant CMD_STDIN => 2; 
     22use constant CMD_INTERACTIVE => 3; 
    1923 
    2024  
    …… 
    3943        white => "\e[37m", 
    4044); 
    41 %C = ( bold => "", underline => "", reset => "", normal => "", black => "",  
     45%C = ( bold => "", nounderline => "", underline => "", reset => "", normal => "", black => "",  
    4246        red => "", green => "", brown => "", blue => "", magenta => "", cyan => "", 
    4347        white => "" ) unless (-t STDOUT); 
    …… 
    4953# Plugin path 
    5054my $PLUGINS = "/usr/local/libexec/$SELF"; 
    51 #$PLUGINS = "./plugins"; 
     55$PLUGINS = "./plugins"; 
    5256our %CONF = ( 
    5357        prompt => {  
    …… 
    116120sub fatal { 
    117121        my $str = "$C{red}$C{bold}FTL @_$C{reset}\n"; 
    118         print($str); 
     122        print(STDERR $str); 
    119123        logger($str); 
    120124        exit 1; 
    …… 
    124128        my $str = "$C{red}$C{bold}ERR @_$C{reset}\n"; 
    125129 
    126         print($str); 
     130        print(STDERR $str); 
    127131        logger($str); 
    128132        return undef; 
    …… 
    132136        my $str = "$C{brown}$C{bold}WRN @_$C{reset}\n"; 
    133137 
    134         print($str); 
     138        print(STDERR $str); 
    135139        logger($str); 
    136140        return undef; 
    …… 
    207211 
    208212sub exec_line { 
     213my $mode = shift; 
    209214my ($type, $action, $ctx) = $CLI->parse("@_"); 
    210215 
    …… 
    214219                $action->($ctx, @{$ctx->args()}); 
    215220        } elsif ($type eq 'ERROR') { 
     221        my @gh = @{$ctx->grammar_history()}; 
     222        my @th = @{$ctx->token_history()}; 
     223        my @ath = @{$ctx->all_tokens()}; 
     224        my $grammar = $gh[$#gh]; 
     225        my @candidates; 
     226                push(@th, "") if $action =~ /More input expected/; 
     227        my $prefix = ' ' x length("@th[0 .. $#th - 1]") . (@th < @ath ? ' ' : ''); 
     228 
     229                $action = "$C{underline}@ath$C{nounderline}\n    $prefix^ $action"; 
     230                for my $key (keys(%{$gh[$#gh]})) { 
     231                my $cmd = $key; 
     232                my $type = ref($grammar->{$key}); 
     233 
     234                        next if $cmd =~ /^[A-Z]+$/; 
     235                        $cmd =~ s/^(\d+\))?(\$(\*)?)?//; 
     236                        if ($type eq 'HASH' and $grammar->{$key}->{HELP}) { 
     237                                $type = ref($grammar->{$key}->{HELP}); 
     238                                if ($type eq 'ARRAY') { 
     239                                        $cmd = $grammar->{$key}->{HELP}->[0]; 
     240                                } elsif ($type eq 'CODE') { 
     241                                my %s = $grammar->{$key}->{HELP}->($ctx, $ctx->args()); 
     242                                        push(@candidates, keys(%s)); 
     243                                        $cmd = undef; 
     244                                } 
     245                        } 
     246                        if (defined($cmd)) { 
     247                                push(@candidates, $cmd); 
     248                        } 
     249                } 
     250                if (@candidates and $grammar->{ACTION}) { 
     251                        push(@candidates, "<eol>"); 
     252                } 
     253                @candidates = sort(@candidates); 
     254                if (@candidates > 1) { 
     255                        $action .= "\n    ${prefix}Candidates are " . join(", ", @candidates[0 .. $#candidates - 1]) . " and " . $candidates[-1] . "."; 
     256                } elsif (@candidates == 1) { 
     257                        $action .= "\n    ${prefix}Expecting @candidates."; 
     258                } else { 
     259                        if ($grammar->{ACTION}) { 
     260                                $action .= "\n    ${prefix}Expected end of command."; 
     261                        } else { 
     262                                $action .= "\n    ${prefix}Can't find any candidates, probably a grammar error." 
     263                        } 
     264                } 
    216265                error($action); 
    217266        } 
    …… 
    417466                } 
    418467        } 
    419         exec_line(@ARGV); 
     468        exec_line(CMD_ARG, @ARGV); 
    420469        exit; 
    421470} 
    …… 
    432481        while (defined($line = $term->readline($PROMPT))) { 
    433482                next if $line =~ /^\s*$/; 
    434                 exec_line($line); 
     483                exec_line(CMD_INTERACTIVE, $line); 
    435484                $BREAK = 0; 
    436485        } 
    …… 
    441490                        next if $line =~ /^\s*$/; 
    442491                        next if $line =~ /^\s*#.*$/; 
    443                         exec_line($line); 
     492                        exec_line(CMD_STDIN, $line); 
    444493                } 
    445494        } else { 

  • manage/trunk/plugins/nodelist2.pm

    r171 r173  
    3939                        HELP => 'List users.' 
    4040                }, 
    41                 '3)$[\w-]+' => { 
     41                '3)$[\w -]+' => { 
    4242                        HELP => [ '<username>', 'User to manage.' ], 
    4343                        remove => { 
    …… 
    7575                                }, 
    7676                        }, 
     77                        '$\d+' => { 
     78                                HELP => sub { 
     79                                        return ( 
     80                                                '<digit>' => 'Fooobbrr' 
     81                                                ); 
     82                                }, 
     83                        }, 
    7784                }, 
    7885        },