3 =head1 NAME $RCSfile: CmdLine.pm,v $
5 Library to implement generic command line interface
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Fri May 13 15:23:37 PDT 2011
25 $Date: 2011/12/23 01:02:49 $
31 Provides an interface to a command line utilizing Term::ReadLine and
32 Term::ReadLine::Gnu. Note, the latter is not part of Perl core and
33 must be downloaded from CPAN. Without Term::ReadLine::Gnu a lot of
34 functionality doesn't work.
36 CmdLine uses a hash to describe what your valid commands are along
37 with help and longer help, i.e. description strings. If you do not
38 define your commands then no command name completion nor help will be
46 help => 'help [<cmd>]'
47 description => 'This is a longer description
51 help => 'execute <cmd>',
52 description => 'Longer description of the execute command',
56 # Create a new cmdline:
57 my $cmdline = CmdLine->new ($FindBin::Script, %cmds);
59 while (my $cmd = $cmdline->get) {
65 This module implements a command line stack using Term::ReadLine and
66 Term::ReadLine::Gnu. If Term::ReadLine::Gnu is not installed then many
67 of the functions do not work. Command completion if commands are
68 defined with a hash as shown above.
70 =head1 DEFAULT COMMANDS
72 The for a list of the builtin commands see %builtin_cmds below
74 Additionally !<n> will re-exeucte a comand from history and !<cmd>
75 will execute <cmd as a shell command.
79 The following routines are exported:
96 use Term::ANSIColor qw (color);
102 my (%_cmds, $_cmdline, $_attribs);
105 # See if we can load Term::ReadLine::Gnu
106 eval { require Term::ReadLine::Gnu };
109 warning "Unable to load Term::ReadLine::Gnu\nCmdLine functionality will be limited!";
121 help => 'history [<start> <end>]',
122 description => 'Displays cmd history. You can specify where to <start> and where to <end>.
123 Default is to list only the last screen full lines of history
124 (as denoted by $LINES).'
128 help => 'help [<cmd>]',
129 description => 'Displays help.',
133 help => 'savehist <file> [<start> <end>]',
134 description => 'Saves a section of the history to a file. You can specify where to <start>
135 and where to <end>. Default is to save all of the history to
136 the specified file.',
141 description => 'Gets a variable.',
145 help => 'set <var>=<expression>',
146 description => 'Sets a variable. Note that expression can be any valid expression.',
151 description => 'Displays all known variables.',
155 help => 'source <file>',
156 description => 'Run commands from a file.',
160 help => 'color [<on|off>]',
161 description => 'Turn on|off color. With no options displays status of color.',
165 help => 'trace [<on|off>]',
166 description => 'Turn on|off tracing. With no options displays status of trace.',
170 sub _cmdCompletion ($$) {
171 my ($text, $state) = @_;
173 return unless %_cmds;
175 $_pos = 0 unless $state;
177 my @cmds = keys %_cmds;
179 for (; $_pos < @cmds;) {
180 return $cmds[$_pos - 1]
181 if $cmds[$_pos++] =~ /^$text/i;
187 sub _complete ($$$$) {
188 my ($text, $line, $start, $end) = @_;
190 return $_cmdline->completion_matches ($text, \&CmdLine::_cmdCompletion);
196 return unless %_cmds;
198 my $line = $_cmdline->{line_buffer};
206 # Sometimes we are called by ReadLine's callback and can't pass $self
207 if (ref $self eq 'CmdLine') {
210 $CmdLine::cmdline->help ($line);
213 $_cmdline->on_new_line;
216 sub _interpolate ($) {
217 my ($self, $str) = @_;
219 # Skip interpolation for the perl command (Note this is raid specific)
221 if $str =~ /^\s*perl\s*/i;
223 while ($str =~ /\$/) {
224 if ($str =~ /\$(\w+)/) {
227 if (defined $self->{vars}{$varname}) {
228 if ($self->{vars}{$varname} =~ / /) {
229 $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/;
231 $str =~ s/\$$varname/$self->{vars}{$varname}/;
234 $str =~ s/\$$varname//;
242 sub _builtinCmds ($) {
243 my ($self, $line) = @_;
245 unless (defined $line) {
252 # Short circut "psuedo" commands of !<n> and !<shellcmd>
253 if ($line =~ /^\s*!\s*(\d+)/) {
254 $line = $self->history ('redo', $1);
255 } elsif ($line =~ /^\s*!\s*(\S+)\s*(.*)/) {
262 #$_cmdline->remove_history ($_cmdline->where_history);
267 if ($line =~ /^\s*(\S+)/) {
276 # Search for matches of partial commands
279 foreach (keys %builtin_cmds) {
281 # Exact match - honor it
285 # Command matched partially
287 # Found first instance of a match
290 # Found second instance of a match - $cmd is not unique
297 # If we found a command, substitute it into line
299 $line =~ s/^\s*$cmd\s*/$foundCmd /;
303 if ($builtin_cmds{$cmd}) {
304 if ($line =~ /^\s*help\s*(.*)/i) {
310 } elsif ($line =~ /^\s*history\s*(.*)/i) {
311 if ($1 =~ /(\d+)\s+(\d+)\s*$/) {
312 $self->history ('list', $1, $2);
313 } elsif ($1 =~ /^\s*$/) {
314 $self->history ('list');
316 error "Invalid usage";
317 $self->help ('history');
319 } elsif ($line =~ /^\s*savehist\s*(.*)/i) {
320 if ($1 =~ /(\S+)\s+(\d+)\s+(\d+)\s*$/) {
321 $self->history ('save', $1, $2, $3);
323 error 'Invalid usage';
324 $self->help ('savehist');
326 } elsif ($line =~ /^\s*get\s*(.*)/i) {
327 if ($1 =~ (/^\$*(\S+)\s*$/)) {
328 my $value = $self->_get ($1);
331 display "$1 = $value";
333 error "$1 is not set";
336 error 'Invalid usage';
339 } elsif ($line =~ /^\s*set\s*(.*)/i) {
340 if ($1 =~ /^\$*(\S+)\s*=\s*(.*)/) {
343 error 'Invalid usage';
346 } elsif ($line =~ /^\s*source\s+(\S+)/i) {
347 $result = $self->source ($1);
348 } elsif ($line =~ /^\s*vars\s*/) {
350 } elsif ($line =~ /^\s*color\s*(.*)/i) {
351 if ($1 =~ /(1|on)/i) {
353 delete $ENV{ANSI_COLORS_DISABLED}
354 if $ENV{ANSI_COLORS_DISABLED};
355 } elsif ($1 =~ /(0|off)/i) {
357 $ENV{ANSI_COLORS_DISABLED} = 1;
358 } elsif ($1 =~ /\s*$/) {
359 if ($ENV{ANSI_COLORS_DISABLED}) {
360 display 'Color is currently off';
362 display 'Color is currently on';
365 error 'Invalid usage';
366 $self->help ('color');
368 } elsif ($line =~ /^\s*trace\s*(.*)/i) {
369 if ($1 =~ /(1|on)/i) {
371 } elsif ($1 =~ /(0|off)/i) {
373 } elsif ($1 =~ /\s*$/) {
375 display 'Trace is currently on';
377 display 'Trace is currently off';
380 error 'Invalid usage';
381 $self->help ('trace');
386 return ($cmd, $line, $result);
390 # Announce that we have hit an interrupt
391 print color ('yellow') . "<Control-C>\n" . color ('reset');
393 # Free up all of the line state info
394 $_cmdline->free_line_state;
396 # Allow readline to clean up
397 $_cmdline->cleanup_after_signal;
399 # Redisplay prompt on a new line
400 $_cmdline->on_new_line;
401 $_cmdline->{line_buffer} = '';
402 $_cmdline->redisplay;
407 sub _displayMatches ($$$) {
408 my ($matches, $numMatches, $maxLength) = @_;
410 # Work on a copy... (Otherwise we were getting "Attempt to free unreferenced
411 # scalar" internal errors from perl)
414 push @Matches, $_ foreach (@$matches);
416 my $match = shift @Matches;
418 if ($match =~/^\s*(.*) /) {
420 } elsif ($match =~ /^\s*(\S+)$/) {
431 $newMatches{$1} = $1;
435 my @newMatches = sort keys %newMatches;
437 unshift @newMatches, $match;
439 $_cmdline->display_match_list (\@newMatches);
440 $_cmdline->on_new_line;
441 $_cmdline->redisplay;
447 my ($class, $histfile, $eval, %cmds) = @_;
453 Construct a new CmdLine object. Note there is already a default
454 CmdLine object created named $cmdline. You should use that unless you
455 have good reason to instantiate another CmdLine object.
459 =for html <blockquote>
465 Set to a file name where to write the history file. If not defined no
470 A hash describing the valid commands and their help/description
475 help => 'List all known commands',
476 description => 'This is a longer description
477 of the list command',
480 help => 'This is a help command',
481 description => 'help <cmd>
482 Longer description of help',
488 =for html </blockquote>
492 =for html <blockquote>
500 =for html </blockquote>
505 histfile => $histfile,
510 $histfile ||= ".${me}_hist";
512 error "Creating bogus .${me}_hist file!"
515 unless (-f $histfile) {
516 open my $hist, '>', $histfile
517 or error "Unable to open $histfile for writing - $!", 1;
522 # Instantiate a commandline
523 $_cmdline = Term::ReadLine->new ($me);
525 # Store the function pointer of what to call when sourcing a file or
526 # evaluating an expression.
528 if (ref $eval eq 'CODE') {
529 $self->{eval} = $eval;
531 error "Invalid function pointer\nUsage: CmdLine->new ($histfile, $eval, %cmds)", 1;
535 # Default prompt is "$me:"
536 $self->{prompt} = "$me:";
539 $self->set_cmds (%cmds);
541 # Set some ornamentation
542 $_cmdline->ornaments ('s,e,u,') unless $Config{cppflags} =~ /win32/i;
545 $self->set_histfile ($histfile);
547 # Generator function for completion matches
548 $_attribs = $_cmdline->Attribs;
550 $_attribs->{attempted_completion_function} = \&CmdLine::_complete;
551 $_attribs->{completion_display_matches_hook} = \&CmdLine::_displayMatches;
552 $_attribs->{completer_word_break_characters} =~ s/ //
553 if $_attribs->{completer_word_break_characters};
555 # The following functionality requires Term::ReadLine::Gnu
557 # Bind a key to display completion
558 $_cmdline->add_defun ('help-on-command', \&CmdLine::_gethelp, ord ("\cl"));
560 # Save a handy copy of RL_PROMPT_[START|END]_IGNORE
561 $self->{ignstart} = $_cmdline->RL_PROMPT_START_IGNORE;
562 $self->{ignstop} = $_cmdline->RL_PROMPT_END_IGNORE;
565 if ($Config{cppflags} =~ /win32/i) {
567 $ENV{ANSI_COLORS_DISABLED} = 1;
580 Retrieves a command line
584 =for html <blockquote>
592 =for html </blockquote>
596 =for html <blockquote>
604 =for html </blockquote>
608 my ($cmd, $line, $result);
611 # Substitute cmdnbr into prompt if we find a '\#'
612 my $prompt = $self->{prompt};
614 $prompt =~ s/\\\#/$self->{cmdnbr}/g;
618 # Term::ReadLine::Gnu restarts whatever system call it is using, such that
619 # once we ctrl C, we don't get back to Perl until the user presses enter,
620 # finally whereupon we get our signal handler called. We use sigaction
621 # instead to use the old perl unsafe signal handling, but only in this read
622 # routine. Sure, sigaction poses race conditions, but you'd either be at a
623 # prompt or executing whatever command your prompt prompted for. The user
624 # has said "Abort that!" with his ctrl-C and we're attempting to honor that.
626 # Damn Windows can't do any of this
629 if ($Config{cppflags} !~ /win32/i) {
630 my $sigset = POSIX::SigSet->new;
631 my $sigaction = POSIX::SigAction->new (\&_interrupt, $sigset, 0);
633 $oldaction = POSIX::SigAction->new;
635 # Set up our unsafe signal handler
636 POSIX::sigaction (&POSIX::SIGINT, $sigaction, $oldaction);
639 $line = $_cmdline->readline ($prompt);
641 # Restore the old signal handler
642 if ($Config{cppflags} !~ /win32/i) {
643 POSIX::sigaction (&POSIX::SIGINT, $oldaction);
646 $line = $self->_interpolate ($line)
650 unless $self->{sourcing};
652 ($cmd, $line, $result) = $self->_builtinCmds ($line);
656 } while ($cmd and $builtin_cmds{$cmd});
658 return ($line, $result);
662 my ($self, %cmds) = @_;
672 =for html <blockquote>
682 =for html </blockquote>
686 =for html <blockquote>
694 =for html </blockquote>
701 foreach (keys %builtin_cmds) {
702 $_cmds{$_}{help} = $builtin_cmds{$_}{help};
703 $_cmds{$_}{description} = $builtin_cmds{$_}{description};
710 my ($self, $prompt) = @_;
720 =for html <blockquote>
730 =for html </blockquote>
734 =for html <blockquote>
742 =for html </blockquote>
746 my $return = $self->{prompt};
748 $self->{prompt} = $prompt;
753 sub set_histfile ($) {
754 my ($self, $histfile) = @_;
764 =for html <blockquote>
774 =for html </blockquote>
778 =for html <blockquote>
786 =for html </blockquote>
790 if ($histfile and -f $histfile) {
791 $self->{histfile} = $histfile;
794 # Clear old history (if any);
795 $_cmdline->clear_history;
798 $_cmdline->ReadHistory ($histfile);
801 # Determine the number of lines in the history file
802 open my $hist, '<', $histfile;
806 $self->{cmdnbr} = $. + 1;
815 my ($self, $eval) = @_;
821 Sets the eval function pointer
825 =for html <blockquote>
831 Function to set eval to. This function will be called with the command
832 line as the only paramter and it should return a result.
836 =for html </blockquote>
840 =for html <blockquote>
848 =for html </blockquote>
852 my $returnEval = $self->{eval};
854 $self->{eval} = $eval;
860 my ($self, $cmd) = @_;
868 Note that the user does not need to explicitly call help - CmdLine's
869 get method will already sense that the builtin help command was
870 invoked and handle it. This method is provided if the caller wishes to
871 call this internally for some reason.
875 =for html <blockquote>
881 Optional command help
885 =for html </blockquote>
889 =for html <blockquote>
897 =for html </blockquote>
907 if ($cmd =~ /^\s*(.+)/) {
908 my ($searchStr, $helpFound);
912 foreach (sort keys %_cmds) {
916 my $cmdcolor = $builtin_cmds{$_} ? color ('cyan') : color ('magenta');
917 my $boldOn = $builtin_cmds{$_} ? color ('white on_cyan') : color ('white on_magenta');
918 my $boldOff = color ('reset') . $cmdcolor;
920 my $cmd = "$cmdcolor$_";
921 $cmd =~ s/($searchStr)/$boldOn$1$boldOff/g;
922 $cmd .= " $_cmds{$_}{parms}" if $_cmds{$_}{parms};
923 $cmd .= color ('reset');
924 $cmd .= " - $_cmds{$_}{help}" if $_cmds{$_}{help};
928 if ($_cmds{$_}{description}) {
930 foreach (split /\n/, $_cmds{$_}{description});
935 unless ($helpFound) {
936 display "I don't know about $cmd";
941 foreach (sort keys %_cmds) {
942 my $cmdcolor = $builtin_cmds{$_} ? color ('cyan') : color ('magenta');
944 my $cmd = "$cmdcolor$_";
945 $cmd .= " $_cmds{$_}{parms}" if $_cmds{$_}{parms};
946 $cmd .= color ('reset');
947 $cmd .= " - $_cmds{$_}{help}" if $_cmds{$_}{help};
951 if ($_cmds{$_}{description}) {
953 foreach (split /\n/, $_cmds{$_}{description});
958 $self->handleOutput ($cmd, @help);
964 my ($self, $action) = @_;
968 =head2 history <action> [<file>] [<start> <end>]
970 This method lists, saves or executes (redo) a command from the history
971 stack. <action> can be one of 'list', 'save' or 'redo'. If listing
972 history one can specify the optional <start> and <end> parameters. If
973 saving then <file> must be specified and optionally <start> and
974 <end>. If redoing a command then only <start> or the command number
977 Note that the user does not need to explicitly call history -
978 CmdLine's get method will already sense that the builtin history
979 command was invoked and handle it. This method is provided if the
980 caller wishes to call this internally for some reason.
984 =for html <blockquote>
990 One of 'list', 'save' or 'redo'
994 =for html </blockquote>
998 =for html <blockquote>
1006 =for html </blockquote>
1010 if ($Config{cppflags} =~ /win32/i) {
1011 warning 'The history command does not work on Windows (sorry)';
1016 my ($file, $start, $end);
1018 if ($action eq 'list') {
1021 } elsif ($action eq 'save') {
1025 } elsif ($action eq 'redo') {
1026 $_cmdline->remove_history ($_cmdline->where_history);
1029 my $line = $_cmdline->history_get ($nbr);
1031 $_cmdline->add_history ($line);
1034 my ($cmd, $result) = $self->_builtinCmds ($line);
1036 if ($builtin_cmds{$cmd}) {
1042 error "Unknown action $action in history";
1046 my $current = $_cmdline->where_history;
1048 my $lines = ($ENV{LINES} ? $ENV{LINES} : 24) - 2;
1050 $start = $current - $lines
1051 unless defined $start;
1055 unless defined $end;
1059 if ($start > $end) {
1060 error "Start ($start) is > end ($end)";
1065 if ($action eq 'save') {
1067 error "Usage: savehist <file> [<start> <end>]";
1072 display_nolf "Overwrite $file (yN)? ";
1074 my $response = <STDIN>;
1076 unless ($response =~ /(y|yes)/i) {
1077 display "Not overwritten";
1082 my $success = open $savefile, '>', $file;
1085 error "Unable to open history file $file - $!";
1090 for (my $pos = $start; $pos <= $end; $pos++) {
1091 my $histline = $_cmdline->history_get ($pos);
1093 last unless $histline;
1095 if ($action eq 'list') {
1096 display "$pos) $histline";
1098 print $savefile "$histline\n";
1103 if $action eq 'save';
1110 my ($self, $name) = @_;
1116 This method gets a variable to a value stored in the CmdLine
1121 =for html <blockquote>
1127 Name of the variable
1131 =for html </blockquote>
1135 =for html <blockquote>
1143 =for html </blockquote>
1147 return $self->{vars}{$name}
1151 my ($self, $name, $value) = @_;
1155 =head2 _set ($name, $value)
1157 This method sets a variable to a value stored in the CmdLine
1158 object. Note $value will be evaluated if eval is set.
1162 =for html <blockquote>
1168 Name of the variable
1172 Value of the variable
1176 =for html </blockquote>
1180 =for html <blockquote>
1188 =for html </blockquote>
1192 my $returnValue = $self->{vars}{$name};
1194 if (defined $value) {
1195 $value = $self->_interpolate ($value);
1197 # Do not call eval if we are setting result - otherwise we recurse
1199 unless ($name eq 'result') {
1201 $value = $self->{eval} ($value)
1206 $self->{vars}{$name} = $value;
1208 delete $self->{vars}{$name};
1211 return $returnValue;
1215 my ($self, $cmd) = @_;
1221 This method will print out all known variables
1225 =for html <blockquote>
1233 =for html </blockquote>
1237 =for html <blockquote>
1245 =for html </blockquote>
1251 push @output, "$_ = $self->{vars}{$_}"
1252 foreach (keys %{$self->{vars}});
1254 $self->handleOutput ($cmd, @output);
1257 sub handleOutput ($@) {
1258 my ($self, $line, @output) = @_;
1262 =head2 handleOutput ($line, @output)
1264 This method will handle outputing the array @output. It also handles redirection
1265 (currently only output redirection) and piping
1269 =for html <blockquote>
1275 The command line used to produce @output. This method parses out redirection
1276 (i.e. > and >>) and piping (|) from $cmd
1280 The output produced by the command to redirect or pipe. (Note this isn't true
1281 piping in that command must run first and produce all of @output before we are
1282 called. Need to look into how to use Perl's pipe command here).
1286 =for html </blockquote>
1290 =for html <blockquote>
1298 =for html </blockquote>
1302 my ($outToFile, $pipeToCmd);
1304 # Handle piping and redirection
1305 if ($line =~ /(.*)\>{2}\s*(.*)/) {
1308 } elsif ($line =~ /(.*)\>{1}\s*(.*)/) {
1311 } elsif ($line =~ /(.*?)\|\s*(.*)/) {
1317 $self->{output} = \@output;
1322 local $SIG{PIPE} = 'IGNORE';
1324 open $pipe, "|$pipeToCmd"
1327 # TODO: Not handling the output here. Need open2 and then recursively call
1334 or error "Unable to close pipe for $pipeToCmd - $!";
1336 error "Unable to open pipe for $pipeToCmd - $!";
1339 unless ($outToFile) {
1342 open my $output, ">$outToFile";
1345 print $output "$_\n"
1352 error "Unable to open $outToFile for writing - $!"
1361 my ($self, $file) = @_;
1365 =head2 source <file>
1367 This method opens a file and sources it's content by executing each
1368 line. Note that the user must have set $self->{eval} to a function
1369 pointer. The function will be called with one parameter - the command
1370 line to execute. The function will return the result from the
1371 execution of the final command.
1373 Note that the user does not need to explicitly call source -
1374 CmdLine's get method will already sense that the builtin source
1375 command was invoked and handle it. This method is provided if the
1376 caller wishes to call this internally for some reason.
1380 =for html <blockquote>
1390 =for html </blockquote>
1394 =for html <blockquote>
1398 =item Returns the result of the last command executed
1402 =for html </blockquote>
1407 error "Unable to open file $file - $!";
1411 open my $source, '<', $file;
1415 $self->{sourcing} = 1;
1424 my $prompt = $self->{prompt};
1426 $prompt =~ s/\\\#/$file:$i/;
1428 display "$prompt$_" if $CmdLine::opts{trace};
1430 next if /^\s*($|\#)/;
1432 $_ = $self->_interpolate ($_);
1434 # Check to see if it's a builtin
1435 my ($cmd, $line, $result) = $self->_builtinCmds ($_);
1437 next if $builtin_cmds{$cmd};
1440 $result = $self->{eval} ($line);
1443 if (defined $result) {
1444 if (ref \$result eq 'SCALAR') {
1445 PageOutput (split /\n/, $result);
1447 display "Sorry but I cannot display structured results";
1452 $self->{sourcing} = 0;
1462 $_cmdline->WriteHistory ($self->{histfile})
1463 if $_cmdline and $_haveGnu;
1466 our $cmdline = CmdLine->new;
1476 =head2 ClearSCM Perl Modules
1478 =for html <p><a href="/php/cvs_man.php?file=lib/Display.pm">Display</a></p>
1480 =head1 BUGS AND LIMITATIONS
1482 There are no known bugs in this module
1484 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1486 =head1 LICENSE AND COPYRIGHT
1488 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.