diff options
Diffstat (limited to 'lib/Reply/Plugin')
-rw-r--r-- | lib/Reply/Plugin/Colors.pm | 66 | ||||
-rw-r--r-- | lib/Reply/Plugin/DataDump.pm | 15 | ||||
-rw-r--r-- | lib/Reply/Plugin/DataDumper.pm | 15 | ||||
-rw-r--r-- | lib/Reply/Plugin/Defaults.pm | 64 | ||||
-rw-r--r-- | lib/Reply/Plugin/FancyPrompt.pm | 20 | ||||
-rw-r--r-- | lib/Reply/Plugin/Hints.pm | 55 | ||||
-rw-r--r-- | lib/Reply/Plugin/Interrupt.pm | 23 | ||||
-rw-r--r-- | lib/Reply/Plugin/LexicalPersistence.pm | 31 | ||||
-rw-r--r-- | lib/Reply/Plugin/LoadClass.pm | 28 | ||||
-rw-r--r-- | lib/Reply/Plugin/Packages.pm | 39 | ||||
-rw-r--r-- | lib/Reply/Plugin/ReadLine.pm | 25 |
11 files changed, 381 insertions, 0 deletions
diff --git a/lib/Reply/Plugin/Colors.pm b/lib/Reply/Plugin/Colors.pm new file mode 100644 index 0000000..199d41e --- /dev/null +++ b/lib/Reply/Plugin/Colors.pm @@ -0,0 +1,66 @@ +package Reply::Plugin::Colors; +use strict; +use warnings; + +use base 'Reply::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 compile { + my $self = shift; + my ($next, @args) = @_; + + local $SIG{__WARN__} = sub { $self->print_warn(@_) }; + $next->(@args); +} + +sub execute { + 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/Reply/Plugin/DataDump.pm b/lib/Reply/Plugin/DataDump.pm new file mode 100644 index 0000000..e80deab --- /dev/null +++ b/lib/Reply/Plugin/DataDump.pm @@ -0,0 +1,15 @@ +package Reply::Plugin::DataDump; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +use Data::Dump 'pp'; + +sub mangle_result { + my $self = shift; + my (@result) = @_; + return @result ? pp(@result) : (); +} + +1; diff --git a/lib/Reply/Plugin/DataDumper.pm b/lib/Reply/Plugin/DataDumper.pm new file mode 100644 index 0000000..676344a --- /dev/null +++ b/lib/Reply/Plugin/DataDumper.pm @@ -0,0 +1,15 @@ +package Reply::Plugin::DataDumper; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +use Data::Dumper; + +sub mangle_result { + my $self = shift; + my (@result) = @_; + return Dumper(@result); +} + +1; diff --git a/lib/Reply/Plugin/Defaults.pm b/lib/Reply/Plugin/Defaults.pm new file mode 100644 index 0000000..507c830 --- /dev/null +++ b/lib/Reply/Plugin/Defaults.pm @@ -0,0 +1,64 @@ +package Reply::Plugin::Defaults; + +# XXX Eval::Closure imposes its own hints on things that are eval'ed at the +# moment, but this may be fixed in the future +BEGIN { + our $default_hints = $^H; + our $default_hinthash = { %^H }; + our $default_warning_bits = ${^WARNING_BITS}; +} + +use strict; +use warnings; + +use base 'Reply::Plugin'; + +use Eval::Closure; + +sub prompt { "> " } + +sub read_line { + my $self = shift; + my ($next, $prompt) = @_; + + print $prompt; + return scalar <>; +} + +my $PREFIX = "package main; BEGIN { \$^H = \$" . __PACKAGE__ . "::default_hints; \%^H = \%\$" . __PACKAGE__ . "::default_hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::default_warning_bits }"; + +sub compile { + my $self = shift; + my ($next, $line, %args) = @_; + + return eval_closure( + source => "sub { $PREFIX; $line }", + terse_error => 1, + %args, + ); +} + +sub execute { + my $self = shift; + my ($next, $code) = @_; + + return $code->(); +} + +sub print_error { + my $self = shift; + my ($next, $error) = @_; + + print $error + if defined $error; +} + +sub print_result { + my $self = shift; + my ($next, @result) = @_; + + print @result, "\n" + if @result; +} + +1; diff --git a/lib/Reply/Plugin/FancyPrompt.pm b/lib/Reply/Plugin/FancyPrompt.pm new file mode 100644 index 0000000..aec5b82 --- /dev/null +++ b/lib/Reply/Plugin/FancyPrompt.pm @@ -0,0 +1,20 @@ +package Reply::Plugin::FancyPrompt; +use strict; +use warnings; + +use base 'Reply::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/Reply/Plugin/Hints.pm b/lib/Reply/Plugin/Hints.pm new file mode 100644 index 0000000..ea0e953 --- /dev/null +++ b/lib/Reply/Plugin/Hints.pm @@ -0,0 +1,55 @@ +package Reply::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 'Reply::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 mangle_line { + my $self = shift; + my ($line) = @_; + + return "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} }"; +} + +sub compile { + 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}; + + my @result = $next->($line, %args); + + $self->{hints} = $hints; + $self->{hinthash} = $hinthash; + $self->{warning_bits} = $warning_bits; + + return @result; +} + +1; diff --git a/lib/Reply/Plugin/Interrupt.pm b/lib/Reply/Plugin/Interrupt.pm new file mode 100644 index 0000000..a5c2b37 --- /dev/null +++ b/lib/Reply/Plugin/Interrupt.pm @@ -0,0 +1,23 @@ +package Reply::Plugin::Interrupt; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +sub compile { + my $self = shift; + my ($next, @args) = @_; + + local $SIG{INT} = sub { die "Interrupted" }; + $next->(@args); +} + +sub execute { + my $self = shift; + my ($next, @args) = @_; + + local $SIG{INT} = sub { die "Interrupted" }; + $next->(@args); +} + +1; diff --git a/lib/Reply/Plugin/LexicalPersistence.pm b/lib/Reply/Plugin/LexicalPersistence.pm new file mode 100644 index 0000000..0540f96 --- /dev/null +++ b/lib/Reply/Plugin/LexicalPersistence.pm @@ -0,0 +1,31 @@ +package Reply::Plugin::LexicalPersistence; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +use Lexical::Persistence; + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + $self->{env} = Lexical::Persistence->new; + return $self; +} + +sub compile { + my $self = shift; + my ($next, $line, %args) = @_; + + my %c = %{ $self->{env}->get_context('_') }; + + $args{environment} ||= {}; + $args{environment} = { + %{ $args{environment} }, + (map { $_ => ref($c{$_}) ? $c{$_} : \$c{$_} } keys %c), + }; + my ($code) = $next->($line, %args); + return $self->{env}->wrap($code); +} + +1; diff --git a/lib/Reply/Plugin/LoadClass.pm b/lib/Reply/Plugin/LoadClass.pm new file mode 100644 index 0000000..8bba634 --- /dev/null +++ b/lib/Reply/Plugin/LoadClass.pm @@ -0,0 +1,28 @@ +package Reply::Plugin::LoadClass; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +use Module::Runtime 'use_package_optimistically'; +use Try::Tiny; + +sub execute { + my $self = shift; + my ($next, @args) = @_; + + try { + $next->(@args); + } + catch { + if (/^Can't locate object method "[^"]*" via package "([^"]*)"/) { + use_package_optimistically($1); + $next->(@args); + } + else { + die $_; + } + } +} + +1; diff --git a/lib/Reply/Plugin/Packages.pm b/lib/Reply/Plugin/Packages.pm new file mode 100644 index 0000000..6f3e32c --- /dev/null +++ b/lib/Reply/Plugin/Packages.pm @@ -0,0 +1,39 @@ +package Reply::Plugin::Packages; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +sub new { + my $class = shift; + + my $self = $class->SUPER::new(@_); + $self->{package} = 'main'; + + return $self; +} + +sub mangle_line { + my $self = shift; + my ($line) = @_; + + return "package $self->{package}; $line; BEGIN { \$" . __PACKAGE__ . "::package = __PACKAGE__ }"; +} + +sub compile { + my $self = shift; + my ($next, @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}; + + my @result = $next->(@args); + + $self->{package} = $package; + + return @result; +} + +1; diff --git a/lib/Reply/Plugin/ReadLine.pm b/lib/Reply/Plugin/ReadLine.pm new file mode 100644 index 0000000..dc9c617 --- /dev/null +++ b/lib/Reply/Plugin/ReadLine.pm @@ -0,0 +1,25 @@ +package Reply::Plugin::ReadLine; +use strict; +use warnings; + +use base 'Reply::Plugin'; + +use Term::ReadLine; + +sub new { + my $class = shift; + + my $self = $class->SUPER::new(@_); + $self->{term} = Term::ReadLine->new('Reply'); + + return $self; +} + +sub read_line { + my $self = shift; + my ($next, $prompt) = @_; + + return $self->{term}->readline($prompt); +} + +1; |