my %builtin_cmds = (
history => {
- help => 'history [<start> <end>]',
- description => 'Displays cmd history. You can specify where to <start> and where to <end>.
-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 <start> and where to <end>\n"
+ . "Default is to list only the last screen full lines of history (as denoted\n"
+ . "by \$LINES).",
},
help => {
description => 'Displays help.',
},
+ helpall => {
+ help => 'helpall',
+ description => 'Display all help, including builtin commands',
+ },
+
savehist => {
- help => 'savehist <file> [<start> <end>]',
- description => 'Saves a section of the history to a file. You can specify where to <start>
-and where to <end>. 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 <start>\n"
+ . "and where to <end>. Default is to save all of the history to the specified\n"
+ . "file.",
},
get => {
- help => 'get <var>',
+ help => 'get [var]',
description => 'Gets a variable.',
},
set => {
- help => 'set <var>=<expression>',
- 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 <file>',
- description => 'Run commands from a file.',
+ help => 'source [file]',
+ description =>
+ 'Run commands from a file.',
},
color => {
- help => 'color [<on|off>]',
- 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 [<on|off>]',
- 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;
} # 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};
# 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)
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
return $str;
} # _interpolate
-sub _builtinCmds ($) {
+sub _builtinCmds($) {
my ($self, $line) = @_;
- unless (defined $line) {
+ unless ($line) {
display '';
return 'exit';
} # unless
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;
last;
} # unless
} # if
- } # foreach
+ } # for
# If we found a command, substitute it into line
if ($foundCmd) {
} # 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 {
} # 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;
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';
} # if
} else {
error 'Invalid usage';
- $self->help ('color');
+ $self->help('color');
} # if
} elsif ($line =~ /^\s*trace\s*(.*)/i) {
if ($1 =~ /(1|on)/i) {
} # if
} else {
error 'Invalid usage';
- $self->help ('trace');
+ $self->help('trace');
} # if
} # if
} # if
return ($cmd, $line, $result);
} # _builtinCmds
-sub _interrupt () {
+sub _interrupt() {
# Announce that we have hit an interrupt
print color ('yellow') . "<Control-C>\n" . color ('reset');
# Free up all of the line state info
$_cmdline->free_line_state;
-
+
# Allow readline to clean up
$_cmdline->cleanup_after_signal;
$_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
=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;
$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;
# 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;
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
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
# 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
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
%_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
return $return;
} # set_prompt
-sub set_histfile ($) {
+sub set_histfile($) {
my ($self, $histfile) = @_;
=pod
if ($histfile and -f $histfile) {
$self->{histfile} = $histfile;
-
+
if ($_haveGnu) {
# Clear old history (if any);
$_cmdline->clear_history;
# 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>) {}
return;
} # set_histfile
-sub set_eval (;\&) {
+sub set_eval(;\&) {
my ($self, $eval) = @_;
=pod
return $returnEval;
} # set_eval
-sub help (;$) {
- my ($self, $cmd) = @_;
+sub help(;$$) {
+ my ($self, $cmd, $builtins) = @_;
=pod
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";
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$_";
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
return;
} # if
-
+
my ($file, $start, $end);
if ($action eq 'list') {
$_cmdline->add_history ($line);
display $line;
- my ($cmd, $result) = $self->_builtinCmds ($line);
+ my ($cmd, $result) = $self->_builtinCmds($line);
if ($builtin_cmds{$cmd}) {
return;
if ($action eq 'save') {
unless ($file) {
- error "Usage: savehist <file> [<start> <end>]";
- return;
+ error "Usage: savehist <file> [<start> <end>]";
+ return;
} # unless
if (-f $file) {
- display_nolf "Overwrite $file (yN)? ";
+ display_nolf "Overwrite $file (yN)? ";
- my $response = <STDIN>;
+ my $response = <STDIN>;
- 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
last unless $histline;
if ($action eq 'list') {
- display "$pos) $histline";
+ display "$pos) $histline";
} else {
- print $savefile "$histline\n";
+ print $savefile "$histline\n";
} # if
} # for
return;
} # history
-sub _get ($$) {
+sub _get($$) {
my ($self, $name) = @_;
=pod
return $self->{vars}{$name}
} # _get
-sub _set ($$) {
+sub _set($$) {
my ($self, $name, $value) = @_;
=pod
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
return $returnValue;
} # _set
-sub vars ($) {
+sub vars($) {
my ($self, $cmd) = @_;
=pod
=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
=cut
my ($outToFile, $pipeToCmd);
-
+
# Handle piping and redirection
if ($line =~ /(.*)\>{2}\s*(.*)/) {
$line = $1;
# 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 {
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
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;
sub DESTROY {
my ($self) = @_;
- $_cmdline->WriteHistory ($self->{histfile})
+ $_cmdline->WriteHistory($self->{histfile})
if $_cmdline and $_haveGnu;
+
+ return;
} # DESTROY
our $cmdline = CmdLine->new;
projects / clearscm.git / blobdiff