App-PerlShell
view release on metacpan or search on metacpan
lib/App/PerlShell.pm view on Meta::CPAN
our $VERSION = "1.09";
use Cwd;
use Term::ReadLine;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my $HAVE_LexPersist = 0;
eval "use Lexical::Persistence 1.01 ()";
if ( !$@ ) {
eval "use App::PerlShell::LexPersist";
$HAVE_LexPersist = 1;
}
my $HAVE_ModRefresh = 0;
eval "use Module::Refresh";
if ( !$@ ) {
eval "use App::PerlShell::ModRefresh";
$HAVE_ModRefresh = 1;
}
my %COMMANDS_INTERNAL = (
debug => 'print command',
exit => 'exit shell'
);
my %COMMANDS = (
'cd' => 'change directory',
'cls' => 'clear screen',
'clear' => 'clear screen',
'commands' => 'print available "commands" (sub)',
'dir' => 'directory listing',
'dumper' => 'use Data::Dumper to display variable',
'env' => 'list environment variables',
'help' => 'shell help - print this',
'ls' => 'directory listing',
'modules' => 'list used modules',
'perldoc' => 'perldoc for current package',
'pwd' => 'print working directory',
'session' => 'start / stop logging session',
'variables' => 'list defined variables',
'version' => 'print version information'
);
use Exporter;
our @EXPORT = sort ( keys ( %COMMANDS ) );
our @ISA = qw ( Exporter );
sub _shellCommands {
return ( %COMMANDS, %COMMANDS_INTERNAL );
}
sub new {
my $self = shift;
my $class = ref($self) || $self;
# Default parameters
my %params = (
homedir => ( $^O eq "MSWin32" ) ? $ENV{USERPROFILE} : $ENV{HOME},
package => __PACKAGE__,
prompt => 'Perl> '
);
my $lex = 0;
my $verbose = 0;
if ( @_ == 1 ) {
croak("Insufficient number of args - @_");
} else {
my %cfg = @_;
for ( keys(%cfg) ) {
if (/^-?homedir$/i) {
if ( -d $cfg{$_} ) {
$params{homedir} = $cfg{$_};
} else {
croak("Cannot find directory `$cfg{$_}'");
}
} elsif (/^-?execute$/i) {
$params{execute} = $cfg{$_};
} elsif (/^-?lex(?:ical)?$/i) {
$lex = 1;
} elsif (/^-?package$/i) {
$params{package} = $cfg{$_};
} elsif (/^-?prompt$/i) {
$params{prompt} = $cfg{$_};
} elsif (/^-?feature$/i) {
$params{feature} = $cfg{$_};
} elsif (/^-?session$/i) {
# assign, will test open in run()
$params{session} = $cfg{$_};
} elsif (/^-?skipvars$/i) {
if ( ref $cfg{$_} eq 'ARRAY' ) {
$params{skipvars} = $cfg{$_};
} else {
croak("Not array reference `$cfg{$_}'");
}
} elsif (/^-?verbose$/i) {
$verbose = 1;
} else {
croak("Unknown parameter `$_' => `$cfg{$_}'");
}
}
}
if ($lex) {
if ($HAVE_LexPersist) {
$params{shellLexEnv}
= App::PerlShell::LexPersist->new( $params{package} );
} else {
croak(
"-lexical specified, `Lexical::Persistence' required but not found"
);
}
}
# Setup Environment Variables
$ENV{PERLSHELL_FEATURE} = $params{feature};
$ENV{PERLSHELL_HOME} = $params{homedir};
$ENV{PERLSHELL_PACKAGE} = $params{package};
$ENV{PERLSHELL_PERLDOC} = 'perldoc';
$ENV{PERLSHELL_PROMPT} = $params{prompt};
$ENV{PERLSHELL_SEMIOFF} = 0;
if ( defined $params{skipvars} ) {
$ENV{PERLSHELL_SKIPVARS} = join ';', @{$params{skipvars}};
}
if ( $verbose ) {
print "$params{execute}\n";
}
# clean up object
delete $params{feature};
delete $params{homedir};
delete $params{package};
delete $params{prompt};
delete $params{skipvars};
return bless \%params, $class;
}
sub run {
my $App_PerlShell_Shell = shift;
# handle session if requested
if ( defined $App_PerlShell_Shell->{session} ) {
if ( not defined session( $App_PerlShell_Shell->{session} ) ) {
croak(
"Cannot open session file `$App_PerlShell_Shell->{session}'");
}
}
if ( exists $App_PerlShell_Shell->{shellLexEnv} ) {
$App_PerlShell_Shell->{shell}
= $App_PerlShell_Shell->{shellLexEnv}->get_package();
} else {
$App_PerlShell_Shell->{shell} = $ENV{PERLSHELL_PACKAGE};
}
$App_PerlShell_Shell->{shell}
= Term::ReadLine->new( $App_PerlShell_Shell->{shell} );
$App_PerlShell_Shell->{shell}->ornaments(0);
#'use strict' is not used to allow "$p=" instead of "my $p=" at the prompt
no strict 'vars';
# will always exeucte without readline first time through (do ... while)
while (1) {
# do ... while loop won't support next and last
# First check then clear {execute} to autopopulate
# $App_PerlShell_Shell->{shellCmdLine}
# otherwise, just do the readline.
if ( defined $App_PerlShell_Shell->{execute} ) {
$App_PerlShell_Shell->{shellCmdLine}
= $App_PerlShell_Shell->{execute};
# clear - it will never happen again
delete $App_PerlShell_Shell->{execute};
} else {
$App_PerlShell_Shell->{shellCmdLine}
.= $App_PerlShell_Shell->{shell}->readline(
( defined $App_PerlShell_Shell->{shellCmdLine} )
? 'More? '
: $ENV{PERLSHELL_PROMPT}
);
}
chomp $App_PerlShell_Shell->{shellCmdLine};
# nothing
if ( $App_PerlShell_Shell->{shellCmdLine} =~ /^\s*$/ ) {
undef $App_PerlShell_Shell->{shellCmdLine};
next;
}
# exit
if ( $App_PerlShell_Shell->{shellCmdLine} =~ /^\s*exit\s*(;)?\s*$/ ) {
if ( not defined $1 ) {
$App_PerlShell_Shell->{shellCmdLine} .= ';';
}
last;
}
# debug multiline
if ( $App_PerlShell_Shell->{shellCmdLine} =~ /\ndebug$/ ) {
$App_PerlShell_Shell->{shellCmdLine} =~ s/debug$//;
print Dumper $App_PerlShell_Shell;
next;
}
# variables if in -lexical
if ( exists $App_PerlShell_Shell->{shellLexEnv} ) {
if ( $App_PerlShell_Shell->{shellCmdLine}
=~ /^\s*variables\s*;\s*$/ ) {
for my $var (
sort( keys(
%{ $App_PerlShell_Shell->{shellLexEnv}
->get_context('_')
}
) )
) {
print "$var\n";
lib/App/PerlShell.pm view on Meta::CPAN
__END__
########################################################
# Start POD
########################################################
=head1 NAME
App::PerlShell - Perl Shell
=head1 SYNOPSIS
use App::PerlShell;
my $shell = App::PerlShell->new();
$shell->run;
=head1 DESCRIPTION
B<App::PerlShell> creates an interactive Perl shell. From it,
Perl commands can be executed. There are some additional commands
helpful in any interactive shell.
=head2 Why Yet Another Perl Shell?
I needed an interactive Perl Shell for some Perl applications I was
writing and found several options on CPAN:
=over 2
=item *
Perl::Shell
=item *
perlconsole
=item *
Devel::REPL
=back
All of which are excellent modules, but none had everything I wanted
without a ton of external dependencies. I didn't want that trade off;
I wanted functions B<without> dependencies.
I also wanted to emulate a shell - not necessarily a REPL
(Read-Evaluate-Parse-Loop). In the way C<sh>, C<bash>, C<csh> and other
*nix or C<cmd.exe> or C<PowerShell> on Windows are a shell - I wanted a Perl
Shell. For example, many of the above modules will evaluate an expression:
5+1
6
If I enter C<5+1> in C<cmd.exe> or C<bash>, I don't get C<6>, I get an error.
In a Perl program, if I have a line C<5+1;>, I get an error in execution. If I
really want C<6>, I need to C<print 5+1;>. And so it should be in the Perl
Shell.
This is much closer to a command prompt / terminal than a REPL. As such,
some basic shell commands are provided, like C<ls>, C<cd> and C<pwd> for
example.
=head1 CAVEATS
For command recall using the up/down arrows in *nix, you will need
B<Term::ReadLine::Gnu> installed. This module will function fine without
it as B<Term::ReadLine> is a core module; however, command recall using
the up/down arrows will not work.
=head1 METHODS
=head2 new() - create a new Shell object
my $shell = App::PerlShell->new([OPTIONS]);
Create a new B<App::PerlShell> object with OPTIONS as optional
parameters. Valid options are:
Option Description Default
------ ----------- -------
-execute Valid Perl code ending statements with (none)
semicolon (;).
-feature Perl feature set to use e.g., ":5.10" :default
-homedir Specify home directory. $ENV{HOME} or
Used for `cd' with no argument. $ENV{USERPROFILE}
-lexical Require "my" for variables. (off)
Requires Lexical::Persistence
-package Package to impersonate. Execute all App::PerlShell
commands as if in this package.
-prompt Shell prompt. Perl>
-session Session file to log commands. (none)
-skipvars Variables to ignore in `variables' $VERSION, @ISA,
command. @EXPORT
=head2 run() - run the shell
$shell->run();
Run the shell. Provides interactive environment for entering commands.
=head1 COMMANDS
In the interactive shell, all valid Perl commands can be entered. This
includes constructs like C<for () {}> and C<if () {} ... else {}> as well
as any subs from C<use>'d modules. The following are also provided.
=over 4
=item B<cd> [('directory')]
Change directory to optional 'directory'. No argument changes to 'homedir'.
Optional return value is current directory (directory before change).
=item B<clear>
=item B<cls>
Clear screen.
=item B<commands> [('SEARCH')]
Displays available commands. Commands are essentially 'sub's defined
in the current package. With 'SEARCH', displays matching commands.
Optional return value is array with commands.
=item B<debug>
Print command so far (don't execute) at multiline input 'More?' prompt. Must
be used as C<debug> only, no semicolon starting at first position in input.
=item B<dir> [('OPTIONS')]
=item B<ls> [('OPTIONS')]
Directory listing. 'OPTIONS' are system directory listing command options.
Optional return value is array of output.
=item B<dumper> $var
Displays C<$var> with Data::Dumper.
=item B<env> [('SEARCH')]
Displays environment variables. With 'SEARCH', displays matching environment
variables. Optional return value is hash with environment variables names as
keys and values as values.
=item B<exit>
Exit shell.
=item B<help>
Display shell help.
=item B<modules> [('SEARCH')]
Displays used modules. With 'SEARCH', displays matching used modules.
Optional return value is hash with module names as keys and file
locations as values.
=item B<perldoc> [('OPTIONS')]
Open C<perldoc> for current PACKAGE. 'OPTIONS' can start with '::' to
append to current PACKAGE, be a full Package name or use C<perldoc>
command line options (e.g., C<-f pack>).
=item B<pwd>
Print working directory. Optional return value is result.
=item B<session> ('file')
Open session file. Only logs Perl commands. Appends to already existing
file. Use C<session (':close')> to end.
=item B<variables>
List user defined variables currently active in current package in shell.
=item B<version>
Print version information.
=back
=head1 EXPORT
( run in 1.253 second using v1.01-cache-2.11-cpan-6aa56a78535 )