From d8a90a03e9c5e8e2732374a10e0e79289ffb793c Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Thu, 30 May 2013 04:41:11 -0500 Subject: App::REPL -> Reply --- bin/repl | 36 ------- bin/reply | 36 +++++++ lib/App/REPL.pm | 167 ------------------------------ lib/App/REPL/Plugin.pm | 7 -- lib/App/REPL/Plugin/Colors.pm | 66 ------------ lib/App/REPL/Plugin/DataDump.pm | 15 --- lib/App/REPL/Plugin/DataDumper.pm | 15 --- lib/App/REPL/Plugin/Defaults.pm | 64 ------------ lib/App/REPL/Plugin/FancyPrompt.pm | 20 ---- lib/App/REPL/Plugin/Hints.pm | 55 ---------- lib/App/REPL/Plugin/Interrupt.pm | 23 ---- lib/App/REPL/Plugin/LexicalPersistence.pm | 31 ------ lib/App/REPL/Plugin/LoadClass.pm | 28 ----- lib/App/REPL/Plugin/Packages.pm | 39 ------- lib/App/REPL/Plugin/ReadLine.pm | 25 ----- lib/Reply.pm | 167 ++++++++++++++++++++++++++++++ lib/Reply/Plugin.pm | 7 ++ lib/Reply/Plugin/Colors.pm | 66 ++++++++++++ lib/Reply/Plugin/DataDump.pm | 15 +++ lib/Reply/Plugin/DataDumper.pm | 15 +++ lib/Reply/Plugin/Defaults.pm | 64 ++++++++++++ lib/Reply/Plugin/FancyPrompt.pm | 20 ++++ lib/Reply/Plugin/Hints.pm | 55 ++++++++++ lib/Reply/Plugin/Interrupt.pm | 23 ++++ lib/Reply/Plugin/LexicalPersistence.pm | 31 ++++++ lib/Reply/Plugin/LoadClass.pm | 28 +++++ lib/Reply/Plugin/Packages.pm | 39 +++++++ lib/Reply/Plugin/ReadLine.pm | 25 +++++ 28 files changed, 591 insertions(+), 591 deletions(-) delete mode 100644 bin/repl create mode 100644 bin/reply delete mode 100644 lib/App/REPL.pm delete mode 100644 lib/App/REPL/Plugin.pm delete mode 100644 lib/App/REPL/Plugin/Colors.pm delete mode 100644 lib/App/REPL/Plugin/DataDump.pm delete mode 100644 lib/App/REPL/Plugin/DataDumper.pm delete mode 100644 lib/App/REPL/Plugin/Defaults.pm delete mode 100644 lib/App/REPL/Plugin/FancyPrompt.pm delete mode 100644 lib/App/REPL/Plugin/Hints.pm delete mode 100644 lib/App/REPL/Plugin/Interrupt.pm delete mode 100644 lib/App/REPL/Plugin/LexicalPersistence.pm delete mode 100644 lib/App/REPL/Plugin/LoadClass.pm delete mode 100644 lib/App/REPL/Plugin/Packages.pm delete mode 100644 lib/App/REPL/Plugin/ReadLine.pm create mode 100644 lib/Reply.pm create mode 100644 lib/Reply/Plugin.pm create mode 100644 lib/Reply/Plugin/Colors.pm create mode 100644 lib/Reply/Plugin/DataDump.pm create mode 100644 lib/Reply/Plugin/DataDumper.pm create mode 100644 lib/Reply/Plugin/Defaults.pm create mode 100644 lib/Reply/Plugin/FancyPrompt.pm create mode 100644 lib/Reply/Plugin/Hints.pm create mode 100644 lib/Reply/Plugin/Interrupt.pm create mode 100644 lib/Reply/Plugin/LexicalPersistence.pm create mode 100644 lib/Reply/Plugin/LoadClass.pm create mode 100644 lib/Reply/Plugin/Packages.pm create mode 100644 lib/Reply/Plugin/ReadLine.pm diff --git a/bin/repl b/bin/repl deleted file mode 100644 index f41f4fd..0000000 --- a/bin/repl +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -# PODNAME: repl - -use App::REPL; - -my $cfg = "$ENV{HOME}/.replrc"; - -my %args = (config => $cfg); -if (!-e $cfg) { - print("$cfg not found. Generating a default...\n"); - if (open my $fh, '>', $cfg) { - print $fh ; - close $fh; - } - else { - warn "Couldn't write to $cfg"; - %args = (); - } -} - -App::REPL->new(%args)->run; - -__DATA__ -script_line1 = use strict -script_line2 = use warnings - -[Interrupt] -[FancyPrompt] -[DataDumper] -[Colors] -[ReadLine] -[Hints] -[Packages] -[LexicalPersistence] diff --git a/bin/reply b/bin/reply new file mode 100644 index 0000000..ddd03e2 --- /dev/null +++ b/bin/reply @@ -0,0 +1,36 @@ +#!/usr/bin/env perl +use strict; +use warnings; +# PODNAME: reply + +use Reply; + +my $cfg = "$ENV{HOME}/.replyrc"; + +my %args = (config => $cfg); +if (!-e $cfg) { + print("$cfg not found. Generating a default...\n"); + if (open my $fh, '>', $cfg) { + print $fh ; + close $fh; + } + else { + warn "Couldn't write to $cfg"; + %args = (); + } +} + +Reply->new(%args)->run; + +__DATA__ +script_line1 = use strict +script_line2 = use warnings + +[Interrupt] +[FancyPrompt] +[DataDumper] +[Colors] +[ReadLine] +[Hints] +[Packages] +[LexicalPersistence] diff --git a/lib/App/REPL.pm b/lib/App/REPL.pm deleted file mode 100644 index 56c6e1d..0000000 --- a/lib/App/REPL.pm +++ /dev/null @@ -1,167 +0,0 @@ -package App::REPL; -use strict; -use warnings; -# ABSTRACT: simple, pluggable repl - -use Config::INI::Reader::Ordered; -use Module::Runtime qw(compose_module_name use_package_optimistically); -use Scalar::Util qw(blessed); -use Try::Tiny; - -sub new { - my $class = shift; - my %opts = @_; - - require App::REPL::Plugin::Defaults; - my $self = bless { - plugins => [], - _default_plugin => App::REPL::Plugin::Defaults->new, - }, $class; - - $self->load_plugin($_) for @{ $opts{plugins} || [] }; - - if (defined $opts{config}) { - print "Loading configuration from $opts{config}... "; - $self->load_config($opts{config}); - print "done\n"; - } - - return $self; -} - -sub load_plugin { - my $self = shift; - my ($plugin, $opts) = @_; - - if (!blessed($plugin)) { - $plugin = compose_module_name("App::REPL::Plugin", $plugin); - use_package_optimistically($plugin); - die "$plugin is not a valid plugin" - unless $plugin->isa("App::REPL::Plugin"); - $plugin = $plugin->new(%$opts); - } - - push @{ $self->{plugins} }, $plugin; -} - -sub load_config { - my $self = shift; - my ($file) = @_; - - my $data = Config::INI::Reader::Ordered->new->read_file($file); - - my $root_config; - for my $section (@$data) { - my ($name, $data) = @$section; - if ($name eq '_') { - $root_config = $data; - } - else { - $self->load_plugin($name => $data); - } - } - - for my $line (sort grep { /^script_line/ } keys %$root_config) { - $self->_eval($root_config->{$line}); - } - - if (defined(my $file = $root_config->{script_file})) { - my $contents = do { - open my $fh, '<', $file or die "Couldn't open $file: $!"; - local $/ = undef; - <$fh> - }; - $self->_eval($contents); - } -} - -sub plugins { - my $self = shift; - - return ( - @{ $self->{plugins} }, - $self->{_default_plugin}, - ); -} - -sub run { - my $self = shift; - - while (defined(my $line = $self->_read)) { - try { - my @result = $self->_eval($line); - $self->_print_result(@result); - } - catch { - $self->_print_error($_); - } - } - print "\n"; -} - -sub _read { - my $self = shift; - - my $prompt = $self->_wrapped_plugin('prompt'); - my ($line) = $self->_wrapped_plugin('read_line', $prompt); - - return $line; -} - -sub _eval { - my $self = shift; - my ($line) = @_; - - ($line) = $self->_chained_plugin('mangle_line', $line) - if defined $line; - - my ($code) = $self->_wrapped_plugin('compile', $line); - return $self->_wrapped_plugin('execute', $code); -} - -sub _print_error { - my $self = shift; - my ($error) = @_; - - ($error) = $self->_chained_plugin('mangle_error', $error); - $self->_wrapped_plugin('print_error', $error); -} - -sub _print_result { - my $self = shift; - my (@result) = @_; - - @result = $self->_chained_plugin('mangle_result', @result); - $self->_wrapped_plugin('print_result', @result); -} - -sub _wrapped_plugin { - my $self = shift; - my @plugins = ref($_[0]) ? @{ shift() } : $self->plugins; - my ($method, @args) = @_; - - @plugins = grep { $_->can($method) } @plugins; - - return @args unless @plugins; - - my $plugin = shift @plugins; - my $next = sub { $self->_wrapped_plugin(\@plugins, $method, @_) }; - - return $plugin->$method($next, @args); -} - -sub _chained_plugin { - my $self = shift; - my @plugins = ref($_[0]) ? @{ shift() } : $self->plugins; - my ($method, @args) = @_; - - @plugins = grep { $_->can($method) } @plugins; - - for my $plugin (@plugins) { - @args = $plugin->$method(@args); - } - - return @args; -} - -1; diff --git a/lib/App/REPL/Plugin.pm b/lib/App/REPL/Plugin.pm deleted file mode 100644 index a255f62..0000000 --- a/lib/App/REPL/Plugin.pm +++ /dev/null @@ -1,7 +0,0 @@ -package App::REPL::Plugin; -use strict; -use warnings; - -sub new { bless {}, shift } - -1; diff --git a/lib/App/REPL/Plugin/Colors.pm b/lib/App/REPL/Plugin/Colors.pm deleted file mode 100644 index dc00cfd..0000000 --- a/lib/App/REPL/Plugin/Colors.pm +++ /dev/null @@ -1,66 +0,0 @@ -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 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/App/REPL/Plugin/DataDump.pm b/lib/App/REPL/Plugin/DataDump.pm deleted file mode 100644 index 7d2934d..0000000 --- a/lib/App/REPL/Plugin/DataDump.pm +++ /dev/null @@ -1,15 +0,0 @@ -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 deleted file mode 100644 index 34e520d..0000000 --- a/lib/App/REPL/Plugin/DataDumper.pm +++ /dev/null @@ -1,15 +0,0 @@ -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/Defaults.pm b/lib/App/REPL/Plugin/Defaults.pm deleted file mode 100644 index ab533b4..0000000 --- a/lib/App/REPL/Plugin/Defaults.pm +++ /dev/null @@ -1,64 +0,0 @@ -package App::REPL::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 'App::REPL::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/App/REPL/Plugin/FancyPrompt.pm b/lib/App/REPL/Plugin/FancyPrompt.pm deleted file mode 100644 index 90e8627..0000000 --- a/lib/App/REPL/Plugin/FancyPrompt.pm +++ /dev/null @@ -1,20 +0,0 @@ -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 deleted file mode 100644 index a09f117..0000000 --- a/lib/App/REPL/Plugin/Hints.pm +++ /dev/null @@ -1,55 +0,0 @@ -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 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/App/REPL/Plugin/Interrupt.pm b/lib/App/REPL/Plugin/Interrupt.pm deleted file mode 100644 index d993a15..0000000 --- a/lib/App/REPL/Plugin/Interrupt.pm +++ /dev/null @@ -1,23 +0,0 @@ -package App::REPL::Plugin::Interrupt; -use strict; -use warnings; - -use base 'App::REPL::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/App/REPL/Plugin/LexicalPersistence.pm b/lib/App/REPL/Plugin/LexicalPersistence.pm deleted file mode 100644 index 986fa03..0000000 --- a/lib/App/REPL/Plugin/LexicalPersistence.pm +++ /dev/null @@ -1,31 +0,0 @@ -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 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/App/REPL/Plugin/LoadClass.pm b/lib/App/REPL/Plugin/LoadClass.pm deleted file mode 100644 index 9a48b22..0000000 --- a/lib/App/REPL/Plugin/LoadClass.pm +++ /dev/null @@ -1,28 +0,0 @@ -package App::REPL::Plugin::LoadClass; -use strict; -use warnings; - -use base 'App::REPL::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/App/REPL/Plugin/Packages.pm b/lib/App/REPL/Plugin/Packages.pm deleted file mode 100644 index c1c02d0..0000000 --- a/lib/App/REPL/Plugin/Packages.pm +++ /dev/null @@ -1,39 +0,0 @@ -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 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/App/REPL/Plugin/ReadLine.pm b/lib/App/REPL/Plugin/ReadLine.pm deleted file mode 100644 index f2fe847..0000000 --- a/lib/App/REPL/Plugin/ReadLine.pm +++ /dev/null @@ -1,25 +0,0 @@ -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; diff --git a/lib/Reply.pm b/lib/Reply.pm new file mode 100644 index 0000000..be79ab8 --- /dev/null +++ b/lib/Reply.pm @@ -0,0 +1,167 @@ +package Reply; +use strict; +use warnings; +# ABSTRACT: read, eval, print, loop, yay! + +use Config::INI::Reader::Ordered; +use Module::Runtime qw(compose_module_name use_package_optimistically); +use Scalar::Util qw(blessed); +use Try::Tiny; + +sub new { + my $class = shift; + my %opts = @_; + + require Reply::Plugin::Defaults; + my $self = bless { + plugins => [], + _default_plugin => Reply::Plugin::Defaults->new, + }, $class; + + $self->load_plugin($_) for @{ $opts{plugins} || [] }; + + if (defined $opts{config}) { + print "Loading configuration from $opts{config}... "; + $self->load_config($opts{config}); + print "done\n"; + } + + return $self; +} + +sub load_plugin { + my $self = shift; + my ($plugin, $opts) = @_; + + if (!blessed($plugin)) { + $plugin = compose_module_name("Reply::Plugin", $plugin); + use_package_optimistically($plugin); + die "$plugin is not a valid plugin" + unless $plugin->isa("Reply::Plugin"); + $plugin = $plugin->new(%$opts); + } + + push @{ $self->{plugins} }, $plugin; +} + +sub load_config { + my $self = shift; + my ($file) = @_; + + my $data = Config::INI::Reader::Ordered->new->read_file($file); + + my $root_config; + for my $section (@$data) { + my ($name, $data) = @$section; + if ($name eq '_') { + $root_config = $data; + } + else { + $self->load_plugin($name => $data); + } + } + + for my $line (sort grep { /^script_line/ } keys %$root_config) { + $self->_eval($root_config->{$line}); + } + + if (defined(my $file = $root_config->{script_file})) { + my $contents = do { + open my $fh, '<', $file or die "Couldn't open $file: $!"; + local $/ = undef; + <$fh> + }; + $self->_eval($contents); + } +} + +sub plugins { + my $self = shift; + + return ( + @{ $self->{plugins} }, + $self->{_default_plugin}, + ); +} + +sub run { + my $self = shift; + + while (defined(my $line = $self->_read)) { + try { + my @result = $self->_eval($line); + $self->_print_result(@result); + } + catch { + $self->_print_error($_); + } + } + print "\n"; +} + +sub _read { + my $self = shift; + + my $prompt = $self->_wrapped_plugin('prompt'); + my ($line) = $self->_wrapped_plugin('read_line', $prompt); + + return $line; +} + +sub _eval { + my $self = shift; + my ($line) = @_; + + ($line) = $self->_chained_plugin('mangle_line', $line) + if defined $line; + + my ($code) = $self->_wrapped_plugin('compile', $line); + return $self->_wrapped_plugin('execute', $code); +} + +sub _print_error { + my $self = shift; + my ($error) = @_; + + ($error) = $self->_chained_plugin('mangle_error', $error); + $self->_wrapped_plugin('print_error', $error); +} + +sub _print_result { + my $self = shift; + my (@result) = @_; + + @result = $self->_chained_plugin('mangle_result', @result); + $self->_wrapped_plugin('print_result', @result); +} + +sub _wrapped_plugin { + my $self = shift; + my @plugins = ref($_[0]) ? @{ shift() } : $self->plugins; + my ($method, @args) = @_; + + @plugins = grep { $_->can($method) } @plugins; + + return @args unless @plugins; + + my $plugin = shift @plugins; + my $next = sub { $self->_wrapped_plugin(\@plugins, $method, @_) }; + + return $plugin->$method($next, @args); +} + +sub _chained_plugin { + my $self = shift; + my @plugins = ref($_[0]) ? @{ shift() } : $self->plugins; + my ($method, @args) = @_; + + @plugins = grep { $_->can($method) } @plugins; + + for my $plugin (@plugins) { + @args = $plugin->$method(@args); + } + + return @args; +} + +1; diff --git a/lib/Reply/Plugin.pm b/lib/Reply/Plugin.pm new file mode 100644 index 0000000..0858758 --- /dev/null +++ b/lib/Reply/Plugin.pm @@ -0,0 +1,7 @@ +package Reply::Plugin; +use strict; +use warnings; + +sub new { bless {}, shift } + +1; 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; -- cgit v1.2.3-54-g00ecf