X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FCmdLine.pm;h=0e1002f9c1eccd3c74dbd679a5a9c2594ae054af;hb=7ddf095f187ca60d9a70fb83b2bc3c2b6d91f088;hp=40ed702a03db090c8a1d55ef39c751509eefaadf;hpb=81cbd130706633b1c19ff59371c2ef61d80c562b;p=clearscm.git diff --git a/lib/CmdLine.pm b/lib/CmdLine.pm index 40ed702..0e1002f 100644 --- a/lib/CmdLine.pm +++ b/lib/CmdLine.pm @@ -118,10 +118,11 @@ our %opts; my %builtin_cmds = ( history => { - help => 'history [ ]', - description => 'Displays cmd history. You can specify where to and where to . -Default is to list only the last screen full lines of history -(as denoted by $LINES).' + help => 'history [[start] [end]]', + description => + "Displays cmd history. You can specify where to and where to \n" + . "Default is to list only the last screen full lines of history (as denoted\n" + . "by \$LINES).", }, help => { @@ -129,45 +130,56 @@ Default is to list only the last screen full lines of history description => 'Displays help.', }, + helpall => { + help => 'helpall', + description => 'Display all help, including builtin commands', + }, + savehist => { - help => 'savehist [ ]', - description => 'Saves a section of the history to a file. You can specify where to -and where to . Default is to save all of the history to -the specified file.', + help => 'savehist [file] [[start] [end]]', + description => + "Saves a section of the history to a file. You can specify where to \n" + . "and where to . Default is to save all of the history to the specified\n" + . "file.", }, get => { - help => 'get ', + help => 'get [var]', description => 'Gets a variable.', }, set => { - help => 'set =', - description => 'Sets a variable. Note that expression can be any valid expression.', + help => 'set [var]=[expression]', + description => + 'Sets a variable. Note that expression can be any valid expression.', }, - vars => { - help => 'vars', - description => 'Displays all known variables.', + vars => { + help => 'vars', + description => + 'Displays all known variables.', }, source => { - help => 'source ', - description => 'Run commands from a file.', + help => 'source [file]', + description => + 'Run commands from a file.', }, color => { - help => 'color []', - description => 'Turn on|off color. With no options displays status of color.', + help => 'color [(on|off)]', + description => + 'Turn on|off color. With no options displays status of color.', }, trace => { - help => 'trace []', - description => 'Turn on|off tracing. With no options displays status of trace.', + help => 'trace [(on|off)]', + description => + 'Turn on|off tracing. With no options displays status of trace.', }, ); -sub _cmdCompletion ($$) { +sub _cmdCompletion($$) { my ($text, $state) = @_; return unless %_cmds; @@ -182,17 +194,17 @@ sub _cmdCompletion ($$) { } # for return; -}# _cmdCompletion +} # _cmdCompletion -sub _complete ($$$$) { +sub _complete($$$$) { my ($text, $line, $start, $end) = @_; - return $_cmdline->completion_matches ($text, \&CmdLine::_cmdCompletion); + return $_cmdline->completion_matches($text, \&CmdLine::_cmdCompletion); } # _complete -sub _gethelp () { +sub _gethelp() { my ($self) = @_; - + return unless %_cmds; my $line = $_cmdline->{line_buffer}; @@ -205,15 +217,17 @@ sub _gethelp () { # Sometimes we are called by ReadLine's callback and can't pass $self if (ref $self eq 'CmdLine') { - $self->help ($line); + $self->help($line); } else { - $CmdLine::cmdline->help ($line); + $CmdLine::cmdline->help($line); } # if $_cmdline->on_new_line; + + return; } # _gethelp -sub _interpolate ($) { +sub _interpolate($) { my ($self, $str) = @_; # Skip interpolation for the perl command (Note this is raid specific) @@ -225,13 +239,13 @@ sub _interpolate ($) { my $varname = $1; if (defined $self->{vars}{$varname}) { - if ($self->{vars}{$varname} =~ / /) { - $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/; - } else { + if ($self->{vars}{$varname} =~ / /) { + $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/; + } else { $str =~ s/\$$varname/$self->{vars}{$varname}/; - } # if + } # if } else { - $str =~ s/\$$varname//; + $str =~ s/\$$varname//; } # if } # if } # while @@ -239,10 +253,10 @@ sub _interpolate ($) { return $str; } # _interpolate -sub _builtinCmds ($) { +sub _builtinCmds($) { my ($self, $line) = @_; - unless (defined $line) { + unless ($line) { display ''; return 'exit'; } # unless @@ -271,12 +285,10 @@ sub _builtinCmds ($) { return unless $cmd; - my @parms; - # Search for matches of partial commands my $foundCmd; - foreach (keys %builtin_cmds) { + for (keys %builtin_cmds) { if ($_ eq $cmd) { # Exact match - honor it $foundCmd = $cmd; @@ -292,7 +304,7 @@ sub _builtinCmds ($) { last; } # unless } # if - } # foreach + } # for # If we found a command, substitute it into line if ($foundCmd) { @@ -301,32 +313,34 @@ sub _builtinCmds ($) { } # if if ($builtin_cmds{$cmd}) { - if ($line =~ /^\s*help\s*(.*)/i) { + if ($line =~ /^\s*helpall\s*$/i) { + $self->help('', 1); + } elsif ($line =~ /^\s*help\s*(.*)/i) { if ($1 =~ /(.+)$/) { - $self->help ($1); + $self->help($1); } else { $self->help; } # if } elsif ($line =~ /^\s*history\s*(.*)/i) { if ($1 =~ /(\d+)\s+(\d+)\s*$/) { - $self->history ('list', $1, $2); + $self->history('list', $1, $2); } elsif ($1 =~ /^\s*$/) { - $self->history ('list'); + $self->history('list'); } else { error "Invalid usage"; - $self->help ('history'); + $self->help('history'); } # if } elsif ($line =~ /^\s*savehist\s*(.*)/i) { if ($1 =~ /(\S+)\s+(\d+)\s+(\d+)\s*$/) { - $self->history ('save', $1, $2, $3); + $self->history('save', $1, $2, $3); } else { error 'Invalid usage'; - $self->help ('savehist'); + $self->help('savehist'); } # if } elsif ($line =~ /^\s*get\s*(.*)/i) { if ($1 =~ (/^\$*(\S+)\s*$/)) { - my $value = $self->_get ($1); - + my $value = $self->_get($1); + if ($value) { display "$1 = $value"; } else { @@ -334,19 +348,19 @@ sub _builtinCmds ($) { } # if } else { error 'Invalid usage'; - $self->help ('get'); + $self->help('get'); } # if } elsif ($line =~ /^\s*set\s*(.*)/i) { if ($1 =~ /^\$*(\S+)\s*=\s*(.*)/) { - $self->_set ($1, $2) + $self->_set($1, $2) } else { error 'Invalid usage'; - $self->help ('set'); + $self->help('set'); } # if } elsif ($line =~ /^\s*source\s+(\S+)/i) { - $result = $self->source ($1); + $result = $self->source($1); } elsif ($line =~ /^\s*vars\s*/) { - $self->vars ($line); + $self->vars($line); } elsif ($line =~ /^\s*color\s*(.*)/i) { if ($1 =~ /(1|on)/i) { $opts{color} = 1; @@ -354,7 +368,7 @@ sub _builtinCmds ($) { if $ENV{ANSI_COLORS_DISABLED}; } elsif ($1 =~ /(0|off)/i) { $opts{trace} = 0; - $ENV{ANSI_COLORS_DISABLED} = 1; + local $ENV{ANSI_COLORS_DISABLED} = 1; } elsif ($1 =~ /\s*$/) { if ($ENV{ANSI_COLORS_DISABLED}) { display 'Color is currently off'; @@ -363,7 +377,7 @@ sub _builtinCmds ($) { } # if } else { error 'Invalid usage'; - $self->help ('color'); + $self->help('color'); } # if } elsif ($line =~ /^\s*trace\s*(.*)/i) { if ($1 =~ /(1|on)/i) { @@ -378,7 +392,7 @@ sub _builtinCmds ($) { } # if } else { error 'Invalid usage'; - $self->help ('trace'); + $self->help('trace'); } # if } # if } # if @@ -386,13 +400,13 @@ sub _builtinCmds ($) { return ($cmd, $line, $result); } # _builtinCmds -sub _interrupt () { +sub _interrupt() { # Announce that we have hit an interrupt print color ('yellow') . "\n" . color ('reset'); # Free up all of the line state info $_cmdline->free_line_state; - + # Allow readline to clean up $_cmdline->cleanup_after_signal; @@ -400,50 +414,50 @@ sub _interrupt () { $_cmdline->on_new_line; $_cmdline->{line_buffer} = ''; $_cmdline->redisplay; - + return; } # _interrupt -sub _displayMatches ($$$) { +sub _displayMatches($$$) { my ($matches, $numMatches, $maxLength) = @_; - + # Work on a copy... (Otherwise we were getting "Attempt to free unreferenced # scalar" internal errors from perl) my @Matches; - - push @Matches, $_ foreach (@$matches); + + push @Matches, $_ for (@$matches); my $match = shift @Matches; - + if ($match =~/^\s*(.*) /) { $match = $1; } elsif ($match =~ /^\s*(\S+)$/) { $match = ''; } # if - + my %newMatches; - - foreach (@Matches) { + + for (@Matches) { # Get next word s/^$match//; - + if (/(\w+)/) { $newMatches{$1} = $1; } # if - } # foreach - + } # for + my @newMatches = sort keys %newMatches; unshift @newMatches, $match; - + $_cmdline->display_match_list (\@newMatches); $_cmdline->on_new_line; $_cmdline->redisplay; - + return; } # _displayMatches - -sub new (;$$%) { + +sub new(;$$%) { my ($class, $histfile, $eval, %cmds) = @_; =pod @@ -501,17 +515,17 @@ Returns: =cut + my $me = get_me; + + $histfile ||= "$ENV{HOME}/.${me}_hist"; + my $self = bless { histfile => $histfile, }, $class; - my $me = get_me; - - $histfile ||= ".${me}_hist"; - error "Creating bogus .${me}_hist file!" - if $me eq '-'; - + if $me eq '-' or $me eq ''; + unless (-f $histfile) { open my $hist, '>', $histfile or error "Unable to open $histfile for writing - $!", 1; @@ -536,13 +550,13 @@ Returns: $self->{prompt} = "$me:"; # Set commands - $self->set_cmds (%cmds); + $self->set_cmds(%cmds); # Set some ornamentation $_cmdline->ornaments ('s,e,u,') unless $Config{cppflags} =~ /win32/i; # Read in history - $self->set_histfile ($histfile); + $self->set_histfile($histfile); # Generator function for completion matches $_attribs = $_cmdline->Attribs; @@ -555,7 +569,7 @@ Returns: # The following functionality requires Term::ReadLine::Gnu if ($_haveGnu) { # Bind a key to display completion - $_cmdline->add_defun ('help-on-command', \&CmdLine::_gethelp, ord ("\cl")); + $_cmdline->add_defun('help-on-command', \&CmdLine::_gethelp, ord ("\cl")); # Save a handy copy of RL_PROMPT_[START|END]_IGNORE $self->{ignstart} = $_cmdline->RL_PROMPT_START_IGNORE; @@ -564,13 +578,13 @@ Returns: if ($Config{cppflags} =~ /win32/i) { $opts{trace} = 0; - $ENV{ANSI_COLORS_DISABLED} = 1; + local $ENV{ANSI_COLORS_DISABLED} = 1; } # if - + return $self; } # new -sub get () { +sub get() { my ($self) = @_; =pod @@ -612,9 +626,9 @@ Returns: my $prompt = $self->{prompt}; $prompt =~ s/\\\#/$self->{cmdnbr}/g; - + use POSIX; - + # Term::ReadLine::Gnu restarts whatever system call it is using, such that # once we ctrl C, we don't get back to Perl until the user presses enter, # finally whereupon we get our signal handler called. We use sigaction @@ -622,16 +636,16 @@ Returns: # routine. Sure, sigaction poses race conditions, but you'd either be at a # prompt or executing whatever command your prompt prompted for. The user # has said "Abort that!" with his ctrl-C and we're attempting to honor that. - + # Damn Windows can't do any of this my $oldaction; - + if ($Config{cppflags} !~ /win32/i) { my $sigset = POSIX::SigSet->new; my $sigaction = POSIX::SigAction->new (\&_interrupt, $sigset, 0); - + $oldaction = POSIX::SigAction->new; - + # Set up our unsafe signal handler POSIX::sigaction (&POSIX::SIGINT, $sigaction, $oldaction); } # if @@ -643,24 +657,22 @@ Returns: POSIX::sigaction (&POSIX::SIGINT, $oldaction); } # if - $line = $self->_interpolate ($line) + $line = $self->_interpolate($line) if $line; - $self->{cmdnbr}++ - unless $self->{sourcing}; + $self->{cmdnbr}++ unless $self->{sourcing}; - ($cmd, $line, $result) = $self->_builtinCmds ($line); + ($cmd, $line, $result) = $self->_builtinCmds($line); - $line = '' - unless $cmd; + $line = '' unless $cmd; } while ($cmd and $builtin_cmds{$cmd}); return ($line, $result); } # get -sub set_cmds (%) { +sub set_cmds(%) { my ($self, %cmds) = @_; - + =pod =head2 set_cmds @@ -698,17 +710,17 @@ Returns: %_cmds = %cmds; # Add in builtins - foreach (keys %builtin_cmds) { + for (keys %builtin_cmds) { $_cmds{$_}{help} = $builtin_cmds{$_}{help}; $_cmds{$_}{description} = $builtin_cmds{$_}{description}; - } # foreach + } # for return; } # set_cmds -sub set_prompt ($) { +sub set_prompt($) { my ($self, $prompt) = @_; - + =pod =head2 set_prompt @@ -750,7 +762,7 @@ Returns: return $return; } # set_prompt -sub set_histfile ($) { +sub set_histfile($) { my ($self, $histfile) = @_; =pod @@ -789,7 +801,7 @@ Returns: if ($histfile and -f $histfile) { $self->{histfile} = $histfile; - + if ($_haveGnu) { # Clear old history (if any); $_cmdline->clear_history; @@ -797,9 +809,10 @@ Returns: # Now read histfile $_cmdline->ReadHistory ($histfile); } # if - + # Determine the number of lines in the history file - open my $hist, '<', $histfile; + open my $hist, '<', $histfile + or croak "Unable to open history file $histfile"; # Set cmdnbr for (<$hist>) {} @@ -811,7 +824,7 @@ Returns: return; } # set_histfile -sub set_eval (;\&) { +sub set_eval(;\&) { my ($self, $eval) = @_; =pod @@ -856,8 +869,8 @@ Returns: return $returnEval; } # set_eval -sub help (;$) { - my ($self, $cmd) = @_; +sub help(;$$) { + my ($self, $cmd, $builtins) = @_; =pod @@ -900,37 +913,36 @@ Returns: my @help; + $builtins ||= 0; + $cmd ||= ''; $cmd =~ s/^\s+//; $cmd =~ s/\s+$//; - + if ($cmd =~ /^\s*(.+)/) { my ($searchStr, $helpFound); - + $searchStr = $1; - foreach (sort keys %_cmds) { + for (sort keys %_cmds) { if (/$searchStr/i) { - $helpFound = 1; - - my $cmdcolor = $builtin_cmds{$_} ? color ('cyan') : color ('magenta'); - my $boldOn = $builtin_cmds{$_} ? color ('white on_cyan') : color ('white on_magenta'); - my $boldOff = color ('reset') . $cmdcolor; - - my $cmd = "$cmdcolor$_"; - $cmd =~ s/($searchStr)/$boldOn$1$boldOff/g; - $cmd .= " $_cmds{$_}{parms}" if $_cmds{$_}{parms}; - $cmd .= color ('reset'); - $cmd .= " - $_cmds{$_}{help}" if $_cmds{$_}{help}; - + $helpFound = 1; + + my $cmdcolor = $builtin_cmds{$_} ? color('cyan') : color('magenta'); + + $cmd = "$cmdcolor$_"; + $cmd .= " $_cmds{$_}{parms}" if $_cmds{$_}{parms}; + $cmd .= color('reset'); + $cmd .= " - $_cmds{$_}{help}" if $_cmds{$_}{help}; + push @help, $cmd; if ($_cmds{$_}{description}) { push @help, " $_" - foreach (split /\n/, $_cmds{$_}{description}); - } # if + for (split /\n/, $_cmds{$_}{description}); + } # if } # if - } # foreach + } # for unless ($helpFound) { display "I don't know about $cmd"; @@ -938,7 +950,9 @@ Returns: return; } # if } else { - foreach (sort keys %_cmds) { + for (sort keys %_cmds) { + next if $builtin_cmds{$_} and not $builtins; + my $cmdcolor = $builtin_cmds{$_} ? color ('cyan') : color ('magenta'); my $cmd = "$cmdcolor$_"; @@ -949,18 +963,18 @@ Returns: push @help, $cmd; if ($_cmds{$_}{description}) { - push @help, " $_" - foreach (split /\n/, $_cmds{$_}{description}); + push @help, " $_" + for (split /\n/, $_cmds{$_}{description}); } # if - } # foreach + } # for } # if - $self->handleOutput ($cmd, @help); + $self->handleOutput($cmd, @help); return; } # help -sub history (;$) { +sub history(;$) { my ($self, $action) = @_; =pod @@ -1012,7 +1026,7 @@ Returns: return; } # if - + my ($file, $start, $end); if ($action eq 'list') { @@ -1031,7 +1045,7 @@ Returns: $_cmdline->add_history ($line); display $line; - my ($cmd, $result) = $self->_builtinCmds ($line); + my ($cmd, $result) = $self->_builtinCmds($line); if ($builtin_cmds{$cmd}) { return; @@ -1064,26 +1078,26 @@ Returns: if ($action eq 'save') { unless ($file) { - error "Usage: savehist [ ]"; - return; + error "Usage: savehist [ ]"; + return; } # unless if (-f $file) { - display_nolf "Overwrite $file (yN)? "; + display_nolf "Overwrite $file (yN)? "; - my $response = ; + my $response = ; - unless ($response =~ /(y|yes)/i) { - display "Not overwritten"; - return; - } # unless + unless ($response =~ /(y|yes)/i) { + display "Not overwritten"; + return; + } # unless } # if my $success = open $savefile, '>', $file; unless ($success) { - error "Unable to open history file $file - $!"; - return; + error "Unable to open history file $file - $!"; + return; } # unless } # if @@ -1093,9 +1107,9 @@ Returns: last unless $histline; if ($action eq 'list') { - display "$pos) $histline"; + display "$pos) $histline"; } else { - print $savefile "$histline\n"; + print $savefile "$histline\n"; } # if } # for @@ -1106,7 +1120,7 @@ Returns: return; } # history -sub _get ($$) { +sub _get($$) { my ($self, $name) = @_; =pod @@ -1147,7 +1161,7 @@ Returns: return $self->{vars}{$name} } # _get -sub _set ($$) { +sub _set($$) { my ($self, $name, $value) = @_; =pod @@ -1192,14 +1206,13 @@ Returns: my $returnValue = $self->{vars}{$name}; if (defined $value) { - $value = $self->_interpolate ($value); - + $value = $self->_interpolate($value); + # Do not call eval if we are setting result - otherwise we recurse # infinitely. unless ($name eq 'result') { no strict; - $value = $self->{eval} ($value) - if $self->{eval}; + $value = $self->{eval}($value) if $self->{eval}; use strict; } # unless @@ -1211,7 +1224,7 @@ Returns: return $returnValue; } # _set -sub vars ($) { +sub vars($) { my ($self, $cmd) = @_; =pod @@ -1247,14 +1260,16 @@ Returns: =cut my @output; - + push @output, "$_ = $self->{vars}{$_}" - foreach (keys %{$self->{vars}}); - - $self->handleOutput ($cmd, @output); + for (keys %{$self->{vars}}); + + $self->handleOutput($cmd, @output); + + return; } # vars -sub handleOutput ($@) { +sub handleOutput($@) { my ($self, $line, @output) = @_; =pod @@ -1300,7 +1315,7 @@ Returns: =cut my ($outToFile, $pipeToCmd); - + # Handle piping and redirection if ($line =~ /(.*)\>{2}\s*(.*)/) { $line = $1; @@ -1315,21 +1330,21 @@ Returns: # Store @output $self->{output} = \@output; - + if ($pipeToCmd) { my $pipe; - + local $SIG{PIPE} = 'IGNORE'; - - open $pipe, "|$pipeToCmd" + + open $pipe, '|', $pipeToCmd or undef $pipe; - + # TODO: Not handling the output here. Need open2 and then recursively call # handleOutput. if ($pipe) { print $pipe "$_\n" - foreach (@output); - + for (@output); + close $pipe or error "Unable to close pipe for $pipeToCmd - $!"; } else { @@ -1339,25 +1354,25 @@ Returns: unless ($outToFile) { PageOutput @output; } else { - open my $output, ">$outToFile"; - + open my $output, '>', $outToFile; + if ($output) { print $output "$_\n" - foreach (@output); + for (@output); close $output; - + undef $outToFile; } else { error "Unable to open $outToFile for writing - $!" } # if } # unless } # if - + return; } # handleOutput -sub source ($) { +sub source($) { my ($self, $file) = @_; =pod @@ -1428,25 +1443,25 @@ Returns: display "$prompt$_" if $CmdLine::opts{trace}; next if /^\s*($|\#)/; - + $_ = $self->_interpolate ($_); - + # Check to see if it's a builtin my ($cmd, $line, $result) = $self->_builtinCmds ($_); - + next if $builtin_cmds{$cmd}; no strict; - $result = $self->{eval} ($line); + $result = $self->{eval}($line); use strict; - + if (defined $result) { if (ref \$result eq 'SCALAR') { PageOutput (split /\n/, $result); } else { display "Sorry but I cannot display structured results"; } # if - } # if + } # if } # while $self->{sourcing} = 0; @@ -1459,8 +1474,10 @@ Returns: sub DESTROY { my ($self) = @_; - $_cmdline->WriteHistory ($self->{histfile}) + $_cmdline->WriteHistory($self->{histfile}) if $_cmdline and $_haveGnu; + + return; } # DESTROY our $cmdline = CmdLine->new;