a few plugins

9 files changed, 257 insertions, 0 deletions

diff --git a/lib/App/REPL/Plugin/Colors.pm b/lib/App/REPL/Plugin/Colors.pm
new file mode 100644
index 0000000..b06f857
--- /dev/null
+++ b/lib/App/REPL/Plugin/Colors.pm
@@ -0,0 +1,58 @@
+package App::REPL::Plugin::Colors;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+use Term::ANSIColor;
+
+sub new {
+    my $class = shift;
+
+    my $self = $class->SUPER::new(@_);
+    $self->{error} = 'red';
+    $self->{warning} = 'yellow';
+    $self->{result} = 'green';
+
+    return $self;
+}
+
+sub evaluate {
+    my $self = shift;
+    my ($next, @args) = @_;
+
+    local $SIG{__WARN__} = sub { $self->print_warn(@_) };
+    $next->(@args);
+}
+
+sub print_error {
+    my $self = shift;
+    my ($next, $error) = @_;
+
+    print color($self->{error});
+    $next->($error);
+    local $| = 1;
+    print color('reset');
+}
+
+sub print_result {
+    my $self = shift;
+    my ($next, @result) = @_;
+
+    print color($self->{result});
+    $next->(@result);
+    local $| = 1;
+    print color('reset');
+}
+
+sub print_warn {
+    my $self = shift;
+    my ($warning) = @_;
+
+    print color($self->{warning});
+    print $warning;
+    local $| = 1;
+    print color('reset');
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/DataDump.pm b/lib/App/REPL/Plugin/DataDump.pm
new file mode 100644
index 0000000..7d2934d
--- /dev/null
+++ b/lib/App/REPL/Plugin/DataDump.pm
@@ -0,0 +1,15 @@
+package App::REPL::Plugin::DataDump;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+use Data::Dump 'pp';
+
+sub mangle_result {
+    my $self = shift;
+    my (@result) = @_;
+    return @result ? pp(@result) : ();
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/DataDumper.pm b/lib/App/REPL/Plugin/DataDumper.pm
new file mode 100644
index 0000000..34e520d
--- /dev/null
+++ b/lib/App/REPL/Plugin/DataDumper.pm
@@ -0,0 +1,15 @@
+package App::REPL::Plugin::DataDumper;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+use Data::Dumper;
+
+sub mangle_result {
+    my $self = shift;
+    my (@result) = @_;
+    return Dumper(@result);
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/FancyPrompt.pm b/lib/App/REPL/Plugin/FancyPrompt.pm
new file mode 100644
index 0000000..90e8627
--- /dev/null
+++ b/lib/App/REPL/Plugin/FancyPrompt.pm
@@ -0,0 +1,20 @@
+package App::REPL::Plugin::FancyPrompt;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    $self->{counter} = 0;
+    return $self;
+}
+
+sub prompt {
+    my $self = shift;
+    my ($next) = @_;
+    return $self->{counter}++ . $next->();
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/Hints.pm b/lib/App/REPL/Plugin/Hints.pm
new file mode 100644
index 0000000..9d198e2
--- /dev/null
+++ b/lib/App/REPL/Plugin/Hints.pm
@@ -0,0 +1,50 @@
+package App::REPL::Plugin::Hints;
+
+my $default_hints;
+my $default_hinthash;
+my $default_warning_bits;
+BEGIN {
+    $default_hints = $^H;
+    $default_hinthash = \%^H;
+    $default_warning_bits = ${^WARNING_BITS};
+}
+
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+sub new {
+    my $class = shift;
+
+    my $self = $class->SUPER::new(@_);
+    $self->{hints} = $default_hints;
+    $self->{hinthash} = $default_hinthash;
+    $self->{warning_bits} = $default_warning_bits;
+
+    return $self;
+}
+
+sub evaluate {
+    my $self = shift;
+    my ($next, $line, %args) = @_;
+
+    # XXX it'd be nice to avoid using globals here, but we can't use
+    # eval_closure's environment parameter since we need to access the
+    # information in a BEGIN block
+    our $hints = $self->{hints};
+    our $hinthash = $self->{hinthash};
+    our $warning_bits = $self->{warning_bits};
+
+    $line = "BEGIN { \$^H = \$" . __PACKAGE__ . "::hints; \%^H = \%\$" . __PACKAGE__ . "::hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::warning_bits } $line; BEGIN { \$" . __PACKAGE__ . "::hints = \$^H; \$" . __PACKAGE__ . "::hinthash = \\\%^H; \$" . __PACKAGE__ . "::warning_bits = \${^WARNING_BITS} }";
+
+    my @result = $next->($line, %args);
+
+    $self->{hints} = $hints;
+    $self->{hinthash} = $hinthash;
+    $self->{warning_bits} = $warning_bits;
+
+    return @result;
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/Interrupt.pm b/lib/App/REPL/Plugin/Interrupt.pm
new file mode 100644
index 0000000..346807e
--- /dev/null
+++ b/lib/App/REPL/Plugin/Interrupt.pm
@@ -0,0 +1,15 @@
+package App::REPL::Plugin::Interrupt;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+sub evaluate {
+    my $self = shift;
+    my ($next, $line, %args) = @_;
+
+    local $SIG{INT} = sub { die "Interrupted" };
+    $next->($line, %args);
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/LexicalPersistence.pm b/lib/App/REPL/Plugin/LexicalPersistence.pm
new file mode 100644
index 0000000..6c9b1d3
--- /dev/null
+++ b/lib/App/REPL/Plugin/LexicalPersistence.pm
@@ -0,0 +1,25 @@
+package App::REPL::Plugin::LexicalPersistence;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+use Lexical::Persistence;
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    $self->{env} = Lexical::Persistence->new;
+    return $self;
+}
+
+sub evaluate {
+    my $self = shift;
+    my ($next, $line, %args) = @_;
+
+    $line = $self->{env}->prepare($line);
+    my ($code) = $next->($line, %args);
+    return $self->{env}->call($code);
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/Packages.pm b/lib/App/REPL/Plugin/Packages.pm
new file mode 100644
index 0000000..d35d3f0
--- /dev/null
+++ b/lib/App/REPL/Plugin/Packages.pm
@@ -0,0 +1,34 @@
+package App::REPL::Plugin::Packages;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+sub new {
+    my $class = shift;
+
+    my $self = $class->SUPER::new(@_);
+    $self->{package} = 'main';
+
+    return $self;
+}
+
+sub evaluate {
+    my $self = shift;
+    my ($next, $line, %args) = @_;
+
+    # XXX it'd be nice to avoid using globals here, but we can't use
+    # eval_closure's environment parameter since we need to access the
+    # information in a BEGIN block
+    our $package = $self->{package};
+
+    $line = "package $package; $line; BEGIN { \$" . __PACKAGE__ . "::package = __PACKAGE__ }";
+
+    my @result = $next->($line, %args);
+
+    $self->{package} = $package;
+
+    return @result;
+}
+
+1;
diff --git a/lib/App/REPL/Plugin/ReadLine.pm b/lib/App/REPL/Plugin/ReadLine.pm
new file mode 100644
index 0000000..f2fe847
--- /dev/null
+++ b/lib/App/REPL/Plugin/ReadLine.pm
@@ -0,0 +1,25 @@
+package App::REPL::Plugin::ReadLine;
+use strict;
+use warnings;
+
+use base 'App::REPL::Plugin';
+
+use Term::ReadLine;
+
+sub new {
+    my $class = shift;
+
+    my $self = $class->SUPER::new(@_);
+    $self->{term} = Term::ReadLine->new('App::REPL');
+
+    return $self;
+}
+
+sub read_line {
+    my $self = shift;
+    my ($next, $prompt) = @_;
+
+    return $self->{term}->readline($prompt);
+}
+
+1;