/usr/share/perl5/PerlConsole/Commands.pm is in perlconsole 0.4-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | package PerlConsole::Commands;
# Copyright © 2007 Alexis Sukrieh
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 51
# Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
use strict;
use warnings;
# All the internal commands of the Perl Console are defined here.
my $help = {
preferences => "Display all the avaialbe preferences and how to change them.",
quit => "Quit the console.",
};
# display the help message
# returns 1 if the string is an internal command
sub isInternalCommand($$)
{
my ($class, $code) = @_;
return 0 unless $code;
chomp($code);
return $code =~ /^\s*:(\S+)\s*/;
}
# Execute the internal command given
sub execute($$$)
{
my ($class, $console, $code) = @_;
# preference : output
if ($code =~ /^\s*:set/) {
if ($code =~ /^\s*:set\s+(\S+)\s*=\s*(\S+)/) {
my ($pref, $val) = ($1, $2);
if ($pref eq "output") {
$console->setOutput($val);
}
else {
$console->setPreference($pref, $val);
}
}
else {
$console->error("invalid syntax for setting a preference, see :help preferences");
}
}
# The main help page
elsif ($code =~ /^\s*:help\s*$/) {
$console->message(PerlConsole::Commands->help($console));
}
# The help page of a specified topic
elsif ($code =~ /^\s*:help\s+(\S+)/) {
$console->message(PerlConsole::Commands->help($console, $1));
}
# display the logs stack
elsif ($code =~ /^\s*:logs/) {
foreach my $log (@{$console->getLogs}) {
$console->message($log);
}
}
# at this point, unrecognized command
else {
$console->error("no such command");
}
return 1;
}
# Returns an help message, on a topic
sub help
{
my ($class, $console, $topic) = @_;
if (! defined $topic) {
return "The following help topics are available:\n".
join("\n- ", keys%{$help});
}
else {
# preferences have automated online help
if ($topic =~ /preferences/) {
return $console->{'prefs'}->help();
}
elsif (grep /^$topic$/, $console->{'prefs'}->getPreferences()) {
return $console->{'prefs'}->help($topic);
}
elsif (defined $help->{$topic}) {
return $help->{$topic};
}
else {
return "No such help topic: $topic";
}
}
}
# END
1;
|