X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-REPL.git;a=blobdiff_plain;f=lib%2FDevel%2FREPL.pm;h=021096660d2cfb2d466745c63f579e33d119efc8;hp=b11d9fb96dc9f470f5a77eaa99188ea2e7b509c2;hb=1282c944f4905dd1689afd286654ed20746c0950;hpb=bbff3c114d9b24546fcee050cff67a3d9dd7e695
diff --git a/lib/Devel/REPL.pm b/lib/Devel/REPL.pm
index b11d9fb..0210966 100644
--- a/lib/Devel/REPL.pm
+++ b/lib/Devel/REPL.pm
@@ -1,51 +1,108 @@
package Devel::REPL;
+# ABSTRACT: A modern perl interactive shell
+
+our $VERSION = '1.003028';
use Term::ReadLine;
use Moose;
-use namespace::clean -except => [ 'meta' ];
-use 5.8.1; # might work with earlier perls but probably not
-
-our $VERSION = '1.002000'; # 1.2.0
+use namespace::autoclean;
+use 5.008001; # backwards compat, doesn't warn like 5.8.1
with 'MooseX::Object::Pluggable';
+use Devel::REPL::Error;
+
has 'term' => (
- is => 'rw', required => 1,
+ is => 'rw',
+ lazy => 1,
default => sub { Term::ReadLine->new('Perl REPL') }
);
has 'prompt' => (
- is => 'rw', required => 1,
+ is => 'rw',
default => sub { '$ ' }
);
has 'out_fh' => (
- is => 'rw', required => 1, lazy => 1,
+ is => 'rw',
+ lazy => 1,
default => sub { shift->term->OUT || \*STDOUT; }
);
+has 'exit_repl' => (
+ is => 'rw',
+ default => sub { 0 }
+);
+
sub run {
my ($self) = @_;
- while ($self->run_once) {
- # keep looping
+ while ($self->run_once_safely) {
+ # keep looping unless we want to exit REPL
+ last if $self->exit_repl;
}
}
-sub run_once {
- my ($self) = @_;
- my $line = $self->read;
- return unless defined($line); # undefined value == EOF
- my @ret = $self->eval($line);
- eval {
- $self->print(@ret);
- };
+sub run_once_safely {
+ my ($self, @args) = @_;
+
+ my $ret = eval { $self->run_once(@args) };
+
if ($@) {
my $error = $@;
- eval { $self->print("Error printing! - $error\n"); };
+ eval { $self->print("Error! - $error\n"); };
+ return 1;
+ } else {
+ return $ret;
}
+}
+
+sub run_once {
+ my ($self) = @_;
+
+ my $line = $self->read;
+ return unless defined($line); # undefined value == EOF
+
+ my @ret = $self->formatted_eval($line);
+
+ $self->print(@ret) unless $self->exit_repl;
+
return 1;
}
+sub formatted_eval {
+ my ( $self, @args ) = @_;
+
+ my @ret = $self->eval(@args);
+
+ return $self->format(@ret);
+}
+
+sub format {
+ my ( $self, @stuff ) = @_;
+
+ if ( $self->is_error($stuff[0]) ) {
+ return $self->format_error(@stuff);
+ } else {
+ return $self->format_result(@stuff);
+ }
+}
+
+sub format_result {
+ my ( $self, @stuff ) = @_;
+
+ return @stuff;
+}
+
+sub format_error {
+ my ( $self, $error ) = @_;
+ return $error->stringify;
+}
+
+sub is_error {
+ my ( $self, $thingy ) = @_;
+ blessed($thingy) and $thingy->isa("Devel::REPL::Error");
+}
+
sub read {
my ($self) = @_;
return $self->term->readline($self->prompt);
@@ -53,22 +110,21 @@ sub read {
sub eval {
my ($self, $line) = @_;
- my ($to_exec, @rest) = $self->compile($line);
- return @rest unless defined($to_exec);
- my @ret = $self->execute($to_exec);
- return @ret;
+ my $compiled = $self->compile($line);
+ return $compiled unless defined($compiled) and not $self->is_error($compiled);
+ return $self->execute($compiled);
}
sub compile {
- my $_REPL = shift;
- my $compiled = eval $_REPL->wrap_as_sub($_[0]);
- return (undef, $_REPL->error_return("Compile error", $@)) if $@;
+ my ( $_REPL, @args ) = @_;
+ my $compiled = eval $_REPL->wrap_as_sub(@args);
+ return $_REPL->error_return("Compile error", $@) if $@;
return $compiled;
}
sub wrap_as_sub {
- my ($self, $line) = @_;
- return qq!sub {\n!.$self->mangle_line($line).qq!\n}\n!;
+ my ($self, $line, %args) = @_;
+ return qq!sub {\n!. ( $args{no_mangling} ? $line : $self->mangle_line($line) ).qq!\n}\n!;
}
sub mangle_line {
@@ -85,7 +141,7 @@ sub execute {
sub error_return {
my ($self, $type, $error) = @_;
- return "${type}: ${error}";
+ return Devel::REPL::Error->new( type => $type, message => $error );
}
sub print {
@@ -96,9 +152,10 @@ sub print {
print $fh "\n" if $self->term->ReadLine =~ /Gnu/;
}
-=head1 NAME
+1;
+__END__
-Devel::REPL - a modern perl interactive shell
+=pod
=head1 SYNOPSIS
@@ -110,30 +167,182 @@ Alternatively, use the 're.pl' script installed with the distribution
system$ re.pl
-=head1 AUTHOR
+=head1 DESCRIPTION
-Matt S Trout - mst (at) shadowcatsystems.co.uk (L)
+This is an interactive shell for Perl, commonly known as a REPL - Read,
+Evaluate, Print, Loop. The shell provides for rapid development or testing
+of code without the need to create a temporary source code file.
-=head1 CONTRIBUTORS
+Through a plugin system, many features are available on demand. You can also
+tailor the environment through the use of profiles and run control files, for
+example to pre-load certain Perl modules when working on a particular project.
-=over 4
+=head1 USAGE
-=item Stevan Little - stevan (at) iinteractive.com
+To start a shell, follow one of the examples in the L"SYNOPSIS"> above.
-=item Alexis Sukrieh - sukria+perl (at) sukria.net
+Once running, the shell accepts and will attempt to execute any code given. If
+the code executes successfully you'll be shown the result, otherwise an error
+message will be returned. Here are a few examples:
-=item epitaph
+ $_ print "Hello, world!\n"
+ Hello, world!
+ 1
+ $_ nosuchfunction
+ Compile error: Bareword "nosuchfunction" not allowed while "strict subs" in use at (eval 130) line 5.
-=item mgrimes - mgrimes (at) cpan dot org
+ $_
-=item Shawn M Moore - sartak (at) gmail.com
+In the first example above you see the output of the command (C), if any, and then the return value of the statement (C<1>). Following
+that example, an error is returned when the execution of some code fails.
-=back
+Note that the lack of semicolon on the end is not a mistake - the code is
+run inside a Block structure (to protect the REPL in case the code blows up),
+which means a single statement doesn't require the semicolon. You can add one
+if you like, though.
-=head1 LICENSE
+If you followed the first example in the L"SYNOPSIS"> above, you'll have the
+L and L
+plugins loaded (and there are many more available).
+Although the shell might support "up-arrow" history, the History plugin adds
+"bang" history to that so you can re-execute chosen commands (with e.g.
+C). The LexEnv plugin ensures that lexical variables declared with the
+C keyword will automatically persist between statements executed in the
+REPL shell.
-This library is free software under the same terms as perl itself
+When you C