summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-08-07 22:28:04 -0400
committerJesse Luehrs <doy@tozt.net>2013-09-03 16:50:15 -0400
commit3e19fb26f62ce9fa02e417c015f6668989d1eaad (patch)
tree411f3292cf712606ad177b5229314eb739db4b7b
parent7df1338f58d10c01cf8f742832b57b2736dbf301 (diff)
downloadreply-3e19fb26f62ce9fa02e417c015f6668989d1eaad.tar.gz
reply-3e19fb26f62ce9fa02e417c015f6668989d1eaad.zip
convert all of the plugins
-rw-r--r--lib/Reply/Plugin/AutoRefresh.pm49
-rw-r--r--lib/Reply/Plugin/Autocomplete/Commands.pm19
-rw-r--r--lib/Reply/Plugin/Autocomplete/Functions.pm51
-rw-r--r--lib/Reply/Plugin/Autocomplete/Globals.pm101
-rw-r--r--lib/Reply/Plugin/Autocomplete/Keywords.pm27
-rw-r--r--lib/Reply/Plugin/Autocomplete/Lexicals.pm55
-rw-r--r--lib/Reply/Plugin/Autocomplete/Methods.pm63
-rw-r--r--lib/Reply/Plugin/Autocomplete/Packages.pm24
-rw-r--r--lib/Reply/Plugin/CollapseStack.pm69
-rw-r--r--lib/Reply/Plugin/Colors.pm91
-rw-r--r--lib/Reply/Plugin/DataDump.pm29
-rw-r--r--lib/Reply/Plugin/DataDumper.pm24
-rw-r--r--lib/Reply/Plugin/DataPrinter.pm11
-rw-r--r--lib/Reply/Plugin/Defaults.pm105
-rw-r--r--lib/Reply/Plugin/Editor.pm80
-rw-r--r--lib/Reply/Plugin/FancyPrompt.pm35
-rw-r--r--lib/Reply/Plugin/Hints.pm71
-rw-r--r--lib/Reply/Plugin/Interrupt.pm26
-rw-r--r--lib/Reply/Plugin/LexicalPersistence.pm40
-rw-r--r--lib/Reply/Plugin/LoadClass.pm27
-rw-r--r--lib/Reply/Plugin/Nopaste.pm133
-rw-r--r--lib/Reply/Plugin/Packages.pm54
-rw-r--r--lib/Reply/Plugin/ReadLine.pm190
-rw-r--r--lib/Reply/Plugin/ResultCache.pm56
-rw-r--r--lib/Reply/Plugin/Timer.pm41
25 files changed, 641 insertions, 830 deletions
diff --git a/lib/Reply/Plugin/AutoRefresh.pm b/lib/Reply/Plugin/AutoRefresh.pm
index 3a21dfb..28daac5 100644
--- a/lib/Reply/Plugin/AutoRefresh.pm
+++ b/lib/Reply/Plugin/AutoRefresh.pm
@@ -1,9 +1,10 @@
-package Reply::Plugin::AutoRefresh;
+package main;
use strict;
use warnings;
# ABSTRACT: automatically refreshes the external code you use
-use base 'Reply::Plugin';
+use mop;
+
use Class::Refresh 0.05 ();
=head1 SYNOPSIS
@@ -28,31 +29,25 @@ modules correctly see the global override.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
-
- $opts{track_require} = 1
- unless defined $opts{track_require};
-
- Class::Refresh->import(track_require => $opts{track_require});
-
- # so that when we load things after this plugin, they get a copy of
- # Module::Runtime which has the call to require() rebound to our overridden
- # copy. if this plugin is loaded first, these should be the only
- # modules loaded so far which load arbitrary user-specified modules.
- Class::Refresh->refresh_module('Module::Runtime');
- Class::Refresh->refresh_module('base');
-
- return $class->SUPER::new(@_);
-}
-
-sub compile {
- my $self = shift;
- my ($next, @args) = @_;
-
- Class::Refresh->refresh;
- $next->(@args);
+class Reply::Plugin::AutoRefresh extends Reply::Plugin {
+ has $track_require = 1;
+
+ submethod BUILD {
+ Class::Refresh->import(track_require => $track_require);
+
+ # so that when we load things after this plugin, they get a copy of
+ # Module::Runtime which has the call to require() rebound to our
+ # overridden copy. if this plugin is loaded first, these should be the
+ # only modules loaded so far which load arbitrary user-specified
+ # modules.
+ Class::Refresh->refresh_module('Module::Runtime');
+ Class::Refresh->refresh_module('base');
+ }
+
+ method compile ($next, @args) {
+ Class::Refresh->refresh;
+ $next->(@args);
+ }
}
1;
diff --git a/lib/Reply/Plugin/Autocomplete/Commands.pm b/lib/Reply/Plugin/Autocomplete/Commands.pm
index e3b653d..5bc0661 100644
--- a/lib/Reply/Plugin/Autocomplete/Commands.pm
+++ b/lib/Reply/Plugin/Autocomplete/Commands.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Commands;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for reply commands
-use base 'Reply::Plugin';
+use mop;
=head1 SYNOPSIS
@@ -17,16 +17,15 @@ This plugin registers a tab key handler to autocomplete Reply commands.
=cut
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
+class Reply::Plugin::Autocomplete::Commands extends Reply::Plugin {
+ method tab_handler ($line) {
+ my ($prefix) = $line =~ /^#(.*)/;
+ return unless defined $prefix;
- my ($prefix) = $line =~ /^#(.*)/;
- return unless defined $prefix;
+ my @commands = $self->publish('commands');
- my @commands = $self->publish('commands');
-
- return map { "#$_" } sort grep { index($_, $prefix) == 0 } @commands;
+ return map { "#$_" } sort grep { index($_, $prefix) == 0 } @commands;
+ }
}
1;
diff --git a/lib/Reply/Plugin/Autocomplete/Functions.pm b/lib/Reply/Plugin/Autocomplete/Functions.pm
index 205841e..2f1f583 100644
--- a/lib/Reply/Plugin/Autocomplete/Functions.pm
+++ b/lib/Reply/Plugin/Autocomplete/Functions.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Functions;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for function names
-use base 'Reply::Plugin';
+use mop;
use Module::Runtime '$module_name_rx';
use Package::Stash;
@@ -21,31 +21,30 @@ code, including imported functions.
=cut
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
-
- my ($before, $fragment) = $line =~ /(.*?)(${module_name_rx}(::)?)$/;
- return unless $fragment;
- return if $before =~ /^#/; # commands
-
- my $current_package = ($self->publish('package'))[-1];
-
- my ($package, $func);
- if ($fragment =~ /:/) {
- ($package, $func) = ($fragment =~ /^(.+:)(\w*)$/);
- $func = '' unless defined $func;
- $package =~ s/:{1,2}$//;
+class Reply::Plugin::Autocomplete::Functions extends Reply::Plugin {
+ method tab_handler ($line) {
+ my ($before, $fragment) = $line =~ /(.*?)(${module_name_rx}(::)?)$/;
+ return unless $fragment;
+ return if $before =~ /^#/; # commands
+
+ my $current_package = ($self->publish('package'))[-1];
+
+ my ($package, $func);
+ if ($fragment =~ /:/) {
+ ($package, $func) = ($fragment =~ /^(.+:)(\w*)$/);
+ $func = '' unless defined $func;
+ $package =~ s/:{1,2}$//;
+ }
+ else {
+ $package = $current_package;
+ $func = $fragment;
+ }
+
+ return
+ map { $package eq $current_package ? $_ : "$package\::$_" }
+ grep { $func ? /^\Q$func/ : 1 }
+ Package::Stash->new($package)->list_all_symbols('CODE');
}
- else {
- $package = $current_package;
- $func = $fragment;
- }
-
- return
- map { $package eq $current_package ? $_ : "$package\::$_" }
- grep { $func ? /^\Q$func/ : 1 }
- 'Package::Stash'->new($package)->list_all_symbols('CODE');
}
1;
diff --git a/lib/Reply/Plugin/Autocomplete/Globals.pm b/lib/Reply/Plugin/Autocomplete/Globals.pm
index ac2ca3e..2bdd673 100644
--- a/lib/Reply/Plugin/Autocomplete/Globals.pm
+++ b/lib/Reply/Plugin/Autocomplete/Globals.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Globals;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for global variables
-use base 'Reply::Plugin';
+use mop;
use Package::Stash;
@@ -22,61 +22,52 @@ Perl code.
=cut
-sub new {
- my $class = shift;
-
- my $self = $class->SUPER::new(@_);
-
- return $self;
-}
-
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
-
- my ($maybe_var) = $line =~ /($fq_varname_rx)$/;
- return unless $maybe_var;
- $maybe_var =~ s/\s+//g;
-
- my ($sigil, $rest) = $maybe_var =~ /(.)(.*)/;
-
- my @parts = split '::', $rest, -1;
- return if grep { /:/ } @parts;
- return if @parts && $parts[0] =~ /^[0-9]/;
-
- my $var_prefix = pop @parts;
- $var_prefix = '' unless defined $var_prefix;
-
- my $stash_name = join('::', @parts);
- my $stash = eval {
- Package::Stash->new(@parts ? $stash_name : 'main')
- };
- return unless $stash;
-
- my @symbols = map { s/^(.)main::/$1/; $_ } _recursive_symbols($stash);
-
- my $prefix = $stash_name
- ? $stash_name . '::' . $var_prefix
- : $var_prefix;
-
- my @results;
- for my $global (@symbols) {
- my ($global_sigil, $global_name) = $global =~ /(.)(.*)/;
- next unless index($global_name, $prefix) == 0;
-
- # this is weird, not sure why % gets stripped but not $ or @
- if ($sigil eq $global_sigil) {
- push @results, $sigil eq '%' ? $global : $global_name;
+class Reply::Plugin::Autocomplete::Globals extends Reply::Plugin {
+ method tab_handler ($line) {
+ my ($maybe_var) = $line =~ /($fq_varname_rx)$/;
+ return unless $maybe_var;
+ $maybe_var =~ s/\s+//g;
+
+ my ($sigil, $rest) = $maybe_var =~ /(.)(.*)/;
+
+ my @parts = split '::', $rest, -1;
+ return if grep { /:/ } @parts;
+ return if @parts && $parts[0] =~ /^[0-9]/;
+
+ my $var_prefix = pop @parts;
+ $var_prefix = '' unless defined $var_prefix;
+
+ my $stash_name = join('::', @parts);
+ my $stash = eval {
+ Package::Stash->new(@parts ? $stash_name : 'main')
+ };
+ return unless $stash;
+
+ my @symbols = map { s/^(.)main::/$1/; $_ } _recursive_symbols($stash);
+
+ my $prefix = $stash_name
+ ? $stash_name . '::' . $var_prefix
+ : $var_prefix;
+
+ my @results;
+ for my $global (@symbols) {
+ my ($global_sigil, $global_name) = $global =~ /(.)(.*)/;
+ next unless index($global_name, $prefix) == 0;
+
+ # this is weird, not sure why % gets stripped but not $ or @
+ if ($sigil eq $global_sigil) {
+ push @results, $sigil eq '%' ? $global : $global_name;
+ }
+ elsif ($global_sigil eq '@' && $sigil eq '$') {
+ push @results, "$global_name\[";
+ }
+ elsif ($global_sigil eq '%') {
+ push @results, "$global_name\{";
+ }
}
- elsif ($global_sigil eq '@' && $sigil eq '$') {
- push @results, "$global_name\[";
- }
- elsif ($global_sigil eq '%') {
- push @results, "$global_name\{";
- }
- }
- return @results;
+ return @results;
+ }
}
sub _recursive_symbols {
diff --git a/lib/Reply/Plugin/Autocomplete/Keywords.pm b/lib/Reply/Plugin/Autocomplete/Keywords.pm
index ee863d1..a17ec41 100644
--- a/lib/Reply/Plugin/Autocomplete/Keywords.pm
+++ b/lib/Reply/Plugin/Autocomplete/Keywords.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Keywords;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for perl keywords
-use base 'Reply::Plugin';
+use mop;
use B::Keywords qw/@Functions @Barewords/;
@@ -19,20 +19,19 @@ This plugin registers a tab key handler to autocomplete keywords in Perl code.
=cut
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
+class Reply::Plugin::Autocomplete::Keywords extends Reply::Plugin {
+ method tab_handler ($line) {
+ my ($before, $last_word) = $line =~ /(.*?)(\w+)$/;
+ return unless $last_word;
+ return if $before =~ /^#/; # command
+ return if $before =~ /::$/; # Package::function call
+ return if $before =~ /->\s*$/; # method call
+ return if $before =~ /[\$\@\%\&\*]\s*$/;
- my ($before, $last_word) = $line =~ /(.*?)(\w+)$/;
- return unless $last_word;
- return if $before =~ /^#/; # command
- return if $before =~ /::$/; # Package::function call
- return if $before =~ /->\s*$/; # method call
- return if $before =~ /[\$\@\%\&\*]\s*$/;
+ my $re = qr/^\Q$last_word/;
- my $re = qr/^\Q$last_word/;
-
- return grep { $_ =~ $re } @Functions, @Barewords;
+ return grep { $_ =~ $re } @Functions, @Barewords;
+ }
}
1;
diff --git a/lib/Reply/Plugin/Autocomplete/Lexicals.pm b/lib/Reply/Plugin/Autocomplete/Lexicals.pm
index c733fed..c3468de 100644
--- a/lib/Reply/Plugin/Autocomplete/Lexicals.pm
+++ b/lib/Reply/Plugin/Autocomplete/Lexicals.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Lexicals;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for lexical variables
-use base 'Reply::Plugin';
+use mop;
use Reply::Util qw($varname_rx);
@@ -20,40 +20,39 @@ Perl code.
=cut
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
+class Reply::Plugin::Autocomplete::Lexicals extends Reply::Plugin {
+ method tab_handler ($line) {
+ my ($var) = $line =~ /($varname_rx)$/;
+ return unless $var;
- my ($var) = $line =~ /($varname_rx)$/;
- return unless $var;
+ my ($sigil, $name_prefix) = $var =~ /(.)(.*)/;
- my ($sigil, $name_prefix) = $var =~ /(.)(.*)/;
+ # these can't be lexicals
+ return if $sigil eq '&' || $sigil eq '*';
- # these can't be lexicals
- return if $sigil eq '&' || $sigil eq '*';
+ my $env = { map { %$_ } $self->publish('lexical_environment') };
+ my @env = keys %$env;
- my $env = { map { %$_ } $self->publish('lexical_environment') };
- my @env = keys %$env;
+ my @results;
+ for my $env_var (@env) {
+ my ($env_sigil, $env_name) = $env_var =~ /(.)(.*)/;
- my @results;
- for my $env_var (@env) {
- my ($env_sigil, $env_name) = $env_var =~ /(.)(.*)/;
+ next unless index($env_name, $name_prefix) == 0;
- next unless index($env_name, $name_prefix) == 0;
-
- # this is weird, not sure why % gets stripped but not $ or @
- if ($sigil eq $env_sigil) {
- push @results, $sigil eq '%' ? $env_var : $env_name;
- }
- elsif ($env_sigil eq '@' && $sigil eq '$') {
- push @results, "$env_name\[";
- }
- elsif ($env_sigil eq '%') {
- push @results, "$env_name\{";
+ # this is weird, not sure why % gets stripped but not $ or @
+ if ($sigil eq $env_sigil) {
+ push @results, $sigil eq '%' ? $env_var : $env_name;
+ }
+ elsif ($env_sigil eq '@' && $sigil eq '$') {
+ push @results, "$env_name\[";
+ }
+ elsif ($env_sigil eq '%') {
+ push @results, "$env_name\{";
+ }
}
- }
- return @results;
+ return @results;
+ }
}
1;
diff --git a/lib/Reply/Plugin/Autocomplete/Methods.pm b/lib/Reply/Plugin/Autocomplete/Methods.pm
index 45a6507..f1fd8b0 100644
--- a/lib/Reply/Plugin/Autocomplete/Methods.pm
+++ b/lib/Reply/Plugin/Autocomplete/Methods.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Methods;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for methods
-use base 'Reply::Plugin';
+use mop;
use Scalar::Util 'blessed';
@@ -22,37 +22,36 @@ code.
=cut
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
-
- my ($invocant, $method_prefix) = $line =~ /($fq_varname_rx|$fq_ident_rx)->($ident_rx)?$/;
- return unless $invocant;
- # XXX unicode
- return unless $invocant =~ /^[\$A-Z_a-z]/;
-
- $method_prefix = '' unless defined $method_prefix;
-
- my $class;
- if ($invocant =~ /^\$/) {
- # XXX should support globals here
- my $env = {
- map { %$_ } $self->publish('lexical_environment'),
- };
- my $var = $env->{$invocant};
- return unless $var && ref($var) eq 'REF' && blessed($$var);
- $class = blessed($$var);
+class Reply::Plugin::Autocomplete::Methods extends Reply::Plugin {
+ method tab_handler ($line) {
+ my ($invocant, $method_prefix) = $line =~ /($fq_varname_rx|$fq_ident_rx)->($ident_rx)?$/;
+ return unless $invocant;
+ # XXX unicode
+ return unless $invocant =~ /^[\$A-Z_a-z]/;
+
+ $method_prefix = '' unless defined $method_prefix;
+
+ my $class;
+ if ($invocant =~ /^\$/) {
+ # XXX should support globals here
+ my $env = {
+ map { %$_ } $self->publish('lexical_environment'),
+ };
+ my $var = $env->{$invocant};
+ return unless $var && ref($var) eq 'REF' && blessed($$var);
+ $class = blessed($$var);
+ }
+ else {
+ $class = $invocant;
+ }
+
+ my @results;
+ for my $method (methods($class)) {
+ push @results, $method if index($method, $method_prefix) == 0;
+ }
+
+ return sort @results;
}
- else {
- $class = $invocant;
- }
-
- my @results;
- for my $method (methods($class)) {
- push @results, $method if index($method, $method_prefix) == 0;
- }
-
- return sort @results;
}
1;
diff --git a/lib/Reply/Plugin/Autocomplete/Packages.pm b/lib/Reply/Plugin/Autocomplete/Packages.pm
index c2bb6a0..aaf3afc 100644
--- a/lib/Reply/Plugin/Autocomplete/Packages.pm
+++ b/lib/Reply/Plugin/Autocomplete/Packages.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Autocomplete::Packages;
+package main;
use strict;
use warnings;
# ABSTRACT: tab completion for package names
-use base 'Reply::Plugin';
+use mop;
use Module::Runtime '$module_name_rx';
@@ -22,18 +22,18 @@ code.
=cut
-sub tab_handler {
- my $self = shift;
- my ($line) = @_;
+class Reply::Plugin::Autocomplete::Packages extends Reply::Plugin {
+ method tab_handler ($line) {
- # $module_name_rx does not permit trailing ::
- my ($before, $package_fragment) = $line =~ /(.*?)(${module_name_rx}:?:?)$/;
- return unless $package_fragment;
- return if $before =~ /^#/; # command
- return if $before =~ /->\s*$/; # method call
- return if $before =~ /[\$\@\%\&\*]\s*$/;
+ # $module_name_rx does not permit trailing ::
+ my ($before, $package_fragment) = $line =~ /(.*?)(${module_name_rx}:?:?)$/;
+ return unless $package_fragment;
+ return if $before =~ /^#/; # command
+ return if $before =~ /->\s*$/; # method call
+ return if $before =~ /[\$\@\%\&\*]\s*$/;
- return sort grep { index($_, $package_fragment) == 0 } all_packages();
+ return sort grep { index($_, $package_fragment) == 0 } all_packages();
+ }
}
1;
diff --git a/lib/Reply/Plugin/CollapseStack.pm b/lib/Reply/Plugin/CollapseStack.pm
index e60c0f5..51cd4fc 100644
--- a/lib/Reply/Plugin/CollapseStack.pm
+++ b/lib/Reply/Plugin/CollapseStack.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::CollapseStack;
+package main;
use strict;
use warnings;
# ABSTRACT: display error stack traces only on demand
-use base 'Reply::Plugin';
+use mop;
{
local @SIG{qw(__DIE__ __WARN__)};
@@ -26,54 +26,39 @@ the C<num_lines> option.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::CollapseStack extends Reply::Plugin {
+ has $num_lines = 1;
- my $self = $class->SUPER::new(@_);
- $self->{num_lines} = $opts{num_lines} || 1;
+ has $full_error;
- return $self;
-}
-
-sub compile {
- my $self = shift;
- my ($next, @args) = @_;
-
- local $SIG{__DIE__} = \&Carp::Always::_die;
- $next->(@args);
-}
-
-sub execute {
- my $self = shift;
- my ($next, @args) = @_;
-
- local $SIG{__DIE__} = \&Carp::Always::_die;
- $next->(@args);
-}
-
-sub mangle_error {
- my $self = shift;
- my $error = shift;
-
- $self->{full_error} = $error;
+ method compile ($next, @args) {
+ local $SIG{__DIE__} = \&Carp::Always::_die;
+ $next->(@args);
+ }
- my @lines = split /\n/, $error;
- if (@lines > $self->{num_lines}) {
- splice @lines, $self->{num_lines};
- $error = join "\n", @lines, " (Run #stack to see the full trace)\n";
+ method execute ($next, @args) {
+ local $SIG{__DIE__} = \&Carp::Always::_die;
+ $next->(@args);
}
- return $error;
-}
+ method mangle_error ($error) {
+ $full_error = $error;
-sub command_stack {
- my $self = shift;
+ my @lines = split /\n/, $error;
+ if (@lines > $num_lines) {
+ splice @lines, $num_lines;
+ $error = join "\n", @lines,
+ " (Run #stack to see the full trace)\n";
+ }
- # XXX should use print_error here
- print($self->{full_error} || "No stack to display.\n");
+ return $error;
+ }
- return '';
+ method command_stack {
+ # XXX should use print_error here
+ print($self->{full_error} || "No stack to display.\n");
+ return '';
+ }
}
=for Pod::Coverage
diff --git a/lib/Reply/Plugin/Colors.pm b/lib/Reply/Plugin/Colors.pm
index aa7e1ef..56c145d 100644
--- a/lib/Reply/Plugin/Colors.pm
+++ b/lib/Reply/Plugin/Colors.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Colors;
+package main;
use strict;
use warnings;
# ABSTRACT: colorize output
-use base 'Reply::Plugin';
+use mop;
use Term::ANSIColor;
BEGIN {
@@ -17,9 +17,9 @@ BEGIN {
; .replyrc
[Colors]
- error = bright red
- warning = bright yellow
- result = bright green
+ error_color = bright red
+ warning_color = bright yellow
+ result_color = bright green
=head1 DESCRIPTION
@@ -32,62 +32,41 @@ C<result> options.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::Colors extends Reply::Plugin {
+ has $error_color = 'red';
+ has $warning_color = 'yellow';
+ has $result_color = 'green';
- my $self = $class->SUPER::new(@_);
- $self->{error} = $opts{error} || 'red';
- $self->{warning} = $opts{warning} || 'yellow';
- $self->{result} = $opts{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');
-}
+ method compile ($next, @args) {
+ local $SIG{__WARN__} = sub { $self->print_warn(@_) };
+ $next->(@args);
+ }
-sub print_result {
- my $self = shift;
- my ($next, @result) = @_;
+ method execute ($next, @args) {
+ local $SIG{__WARN__} = sub { $self->print_warn(@_) };
+ $next->(@args);
+ }
- print color($self->{result});
- $next->(@result);
- local $| = 1;
- print color('reset');
-}
+ method print_error ($next, $error) {
+ print color($error_color);
+ $next->($error);
+ local $| = 1;
+ print color('reset');
+ }
-sub print_warn {
- my $self = shift;
- my ($warning) = @_;
+ method print_result ($next, @result) {
+ print color($result_color);
+ $next->(@result);
+ local $| = 1;
+ print color('reset');
+ }
- print color($self->{warning});
- print $warning;
- local $| = 1;
- print color('reset');
+ method print_warn ($warning) {
+ print color($warning_color);
+ print $warning;
+ local $| = 1;
+ print color('reset');
+ }
}
=for Pod::Coverage
diff --git a/lib/Reply/Plugin/DataDump.pm b/lib/Reply/Plugin/DataDump.pm
index 850d0b2..a2e90e2 100644
--- a/lib/Reply/Plugin/DataDump.pm
+++ b/lib/Reply/Plugin/DataDump.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::DataDump;
+package main;
use strict;
use warnings;
# ABSTRACT: format results using Data::Dump
-use base 'Reply::Plugin';
+use mop;
use Data::Dump 'dumpf';
use overload ();
@@ -23,14 +23,9 @@ value.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
- $opts{respect_stringification} = 1
- unless defined $opts{respect_stringification};
-
- my $self = $class->SUPER::new(@_);
- $self->{filter} = sub {
+class Reply::Plugin::DataDump extends Reply::Plugin {
+ has $respect_stringification = 1;
+ has $filter = sub {
my ($ctx, $ref) = @_;
return unless $ctx->is_blessed;
my $stringify = overload::Method($ref, '""');
@@ -38,15 +33,15 @@ sub new {
return {
dump => $stringify->($ref),
};
- } if $opts{respect_stringification};
+ };
- return $self;
-}
+ submethod BUILD {
+ undef $filter unless $respect_stringification;
+ }
-sub mangle_result {
- my $self = shift;
- my (@result) = @_;
- return @result ? dumpf(@result, $self->{filter}) : ();
+ method mangle_result (@result) {
+ return @result ? dumpf(@result, $filter) : ();
+ }
}
1;
diff --git a/lib/Reply/Plugin/DataDumper.pm b/lib/Reply/Plugin/DataDumper.pm
index 55a85e1..ad8d68e 100644
--- a/lib/Reply/Plugin/DataDumper.pm
+++ b/lib/Reply/Plugin/DataDumper.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::DataDumper;
+package main;
use strict;
use warnings;
# ABSTRACT: format results using Data::Dumper
-use base 'Reply::Plugin';
+use mop;
use Data::Dumper;
@@ -18,19 +18,15 @@ This plugin uses L<Data::Dumper> to format results.
=cut
-sub new {
- my $class = shift;
+class Reply::Plugin::DataDumper extends Reply::Plugin {
+ submethod BUILD {
+ $Data::Dumper::Terse = 1;
+ $Data::Dumper::Sortkeys = 1;
+ }
- $Data::Dumper::Terse = 1;
- $Data::Dumper::Sortkeys = 1;
-
- return $class->SUPER::new(@_);
-}
-
-sub mangle_result {
- my $self = shift;
- my (@result) = @_;
- return Dumper(@result == 0 ? () : @result == 1 ? $result[0] : \@result);
+ method mangle_result (@result) {
+ return Dumper(@result == 0 ? () : @result == 1 ? $result[0] : \@result);
+ }
}
1;
diff --git a/lib/Reply/Plugin/DataPrinter.pm b/lib/Reply/Plugin/DataPrinter.pm
index f048a47..05328db 100644
--- a/lib/Reply/Plugin/DataPrinter.pm
+++ b/lib/Reply/Plugin/DataPrinter.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::DataPrinter;
+package main;
use strict;
use warnings;
# ABSTRACT: format results using Data::Printer
-use base 'Reply::Plugin';
+use mop;
use Data::Printer alias => 'p', colored => 1;
@@ -18,9 +18,10 @@ This plugin uses L<Data::Printer> to format results.
=cut
-sub mangle_result {
- my ($self, @result) = @_;
- return p(@result, return_value => 'dump');
+class Reply::Plugin::DataPrinter extends Reply::Plugin {
+ method mangle_result (@result) {
+ return p(@result, return_value => 'dump');
+ }
}
1;
diff --git a/lib/Reply/Plugin/Defaults.pm b/lib/Reply/Plugin/Defaults.pm
index e7874e3..7b595a9 100644
--- a/lib/Reply/Plugin/Defaults.pm
+++ b/lib/Reply/Plugin/Defaults.pm
@@ -1,4 +1,4 @@
-package Reply::Plugin::Defaults;
+package main;
# XXX Eval::Closure imposes its own hints on things that are eval'ed at the
# moment, but this may be fixed in the future
@@ -11,29 +11,10 @@ BEGIN {
use strict;
use warnings;
-use base 'Reply::Plugin';
+use mop;
use Eval::Closure 0.11;
-sub new {
- my $class = shift;
-
- my $self = $class->SUPER::new(@_);
- $self->{quit} = 0;
-
- return $self;
-}
-
-sub prompt { "> " }
-
-sub read_line {
- my $self = shift;
- my ($next, $prompt) = @_;
-
- print $prompt;
- return scalar <STDIN>;
-}
-
(my $PREFIX = <<'PREFIX') =~ s/__PACKAGE__/__PACKAGE__/ge;
BEGIN {
$^H = $__PACKAGE__::default_hints;
@@ -42,62 +23,54 @@ BEGIN {
}
PREFIX
-sub compile {
- my $self = shift;
- my ($next, $line, %args) = @_;
+class Reply::Plugin::Defaults extends Reply::Plugin {
+ has $quit = 0;
- my $env = { map { %$_ } $self->publish('lexical_environment') };
- my $package = ($self->publish('package'))[-1];
+ method prompt { "> " }
- my $prefix = "package $package;\n$PREFIX";
+ method read_line ($next, $prompt) {
+ print $prompt;
+ return scalar <STDIN>;
+ }
- my $code = eval_closure(
- source => "sub {\n$prefix;\n$line\n}",
- terse_error => 1,
- alias => 1,
- environment => $env,
- %args,
- );
+ method compile ($next, $line, %args) {
+ my $env = { map { %$_ } $self->publish('lexical_environment') };
+ my $package = ($self->publish('package'))[-1];
- return $code;
-}
-
-sub execute {
- my $self = shift;
- my ($next, $code, @args) = @_;
-
- return $code->(@args);
-}
+ my $prefix = "package $package;\n$PREFIX";
-sub print_error {
- my $self = shift;
- my ($next, $error) = @_;
+ my $code = eval_closure(
+ source => "sub {\n$prefix;\n$line\n}",
+ terse_error => 1,
+ alias => 1,
+ environment => $env,
+ %args,
+ );
- print $error
- if defined $error;
-}
-
-sub print_result {
- my $self = shift;
- my ($next, @result) = @_;
+ return $code;
+ }
- print @result, "\n"
- if @result;
-}
+ method execute ($next, $code, @args) {
+ return $code->(@args);
+ }
-sub command_q {
- my $self = shift;
- $self->{quit} = 1;
- return '';
-}
+ method print_error ($next, $error) {
+ print $error if defined $error;
+ }
-sub loop {
- my $self = shift;
- my ($continue) = @_;
+ method print_result ($next, @result) {
+ print @result, "\n" if @result;
+ }
- $continue = 0 if $self->{quit};
+ method command_q {
+ $quit = 1;
+ return '';
+ }
- return $continue;
+ method loop ($continue) {
+ $continue = 0 if $quit;
+ $continue;
+ }
}
=begin Pod::Coverage
diff --git a/lib/Reply/Plugin/Editor.pm b/lib/Reply/Plugin/Editor.pm
index 5032a7d..8f980cd 100644
--- a/lib/Reply/Plugin/Editor.pm
+++ b/lib/Reply/Plugin/Editor.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Editor;
+package main;
use strict;
use warnings;
# ABSTRACT: command to edit the current line in a text editor
-use base 'Reply::Plugin';
+use mop;
use File::HomeDir;
use File::Spec;
@@ -28,52 +28,50 @@ otherwise it will use the value of C<$ENV{VISUAL}> or C<$ENV{EDITOR}>.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::Editor extends Reply::Plugin {
+ has $editor;
+ has $current_text = '';
- my $self = $class->SUPER::new(@_);
- $self->{editor} = Proc::InvokeEditor->new(
- (defined $opts{editor}
- ? (editors => [ $opts{editor} ])
- : ())
- );
- $self->{current_text} = '';
-
- return $self;
-}
+ submethod BUILD ($opts) {
+ $editor = Proc::InvokeEditor->new(
+ (defined $opts->{editor}
+ ? (editors => [ $opts->{editor} ])
+ : ())
+ );
+ }
-sub command_e {
- my $self = shift;
- my ($line) = @_;
+ method command_e ($line) {
+ my $text;
+ if (length $line) {
+ if ($line =~ s+^~/++) {
+ $line = File::Spec->catfile(File::HomeDir->my_home, $line);
+ }
+ elsif ($line =~ s+^~([^/]*)/++) {
+ $line = File::Spec->catfile(
+ File::HomeDir->users_home($1),
+ $line,
+ );
+ }
- my $text;
- if (length $line) {
- if ($line =~ s+^~/++) {
- $line = File::Spec->catfile(File::HomeDir->my_home, $line);
+ my $current_text = do {
+ local $/;
+ if (open my $fh, '<', $line) {
+ <$fh>;
+ }
+ else {
+ warn "Couldn't open $line: $!";
+ return '';
+ }
+ };
+ $text = $editor->edit($current_text, '.pl');
}
- elsif ($line =~ s+^~([^/]*)/++) {
- $line = File::Spec->catfile(File::HomeDir->users_home($1), $line);
+ else {
+ $text = $editor->edit($current_text, '.pl');
+ $current_text = $text;
}
- my $current_text = do {
- local $/;
- if (open my $fh, '<', $line) {
- <$fh>;
- }
- else {
- warn "Couldn't open $line: $!";
- return '';
- }
- };
- $text = $self->{editor}->edit($current_text, '.pl');
+ return $text;
}
- else {
- $text = $self->{editor}->edit($self->{current_text}, '.pl');
- $self->{current_text} = $text;
- }
-
- return $text;
}
=for Pod::Coverage
diff --git a/lib/Reply/Plugin/FancyPrompt.pm b/lib/Reply/Plugin/FancyPrompt.pm
index 7a0d415..c074bff 100644
--- a/lib/Reply/Plugin/FancyPrompt.pm
+++ b/lib/Reply/Plugin/FancyPrompt.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::FancyPrompt;
+package main;
use strict;
use warnings;
# ABSTRACT: provides a more informative prompt
-use base 'Reply::Plugin';
+use mop;
=head1 SYNOPSIS
@@ -18,27 +18,20 @@ current session.
=cut
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- $self->{counter} = 0;
- $self->{prompted} = 0;
- return $self;
-}
+class Reply::Plugin::FancyPrompt extends Reply::Plugin {
+ has $counter = 0;
+ has $prompted = 0;
-sub prompt {
- my $self = shift;
- my ($next) = @_;
- $self->{prompted} = 1;
- return $self->{counter} . $next->();
-}
+ method prompt ($next) {
+ $prompted = 1;
+ return $counter . $next->();
+ }
-sub loop {
- my $self = shift;
- my ($continue) = @_;
- $self->{counter}++ if $self->{prompted};
- $self->{prompted} = 0;
- $continue;
+ method loop ($continue) {
+ $counter++ if $prompted;
+ $prompted = 0;
+ $continue;
+ }
}
1;
diff --git a/lib/Reply/Plugin/Hints.pm b/lib/Reply/Plugin/Hints.pm
index d36d14a..a944e40 100644
--- a/lib/Reply/Plugin/Hints.pm
+++ b/lib/Reply/Plugin/Hints.pm
@@ -1,11 +1,11 @@
-package Reply::Plugin::Hints;
+package main;
my $default_hints;
my $default_hinthash;
my $default_warning_bits;
BEGIN {
$default_hints = $^H;
- $default_hinthash = \%^H;
+ $default_hinthash = { %^H };
$default_warning_bits = ${^WARNING_BITS};
}
@@ -13,7 +13,7 @@ use strict;
use warnings;
# ABSTRACT: persists lexical hints across input lines
-use base 'Reply::Plugin';
+use mop;
=head1 SYNOPSIS
@@ -29,56 +29,45 @@ lines (at least until C<no strict> is given).
=cut
-sub new {
- my $class = shift;
+class Reply::Plugin::Hints extends Reply::Plugin {
+ has $hints = $default_hints;
+ has $hinthash = $default_hinthash;
+ has $warning_bits = $default_warning_bits;
- 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) = @_;
-
- my $package = __PACKAGE__;
- return <<LINE;
+ method mangle_line ($line) {
+ my $package = __PACKAGE__;
+ return <<LINE;
BEGIN {
- \$^H = \$${package}::hints;
- \%^H = \%\$${package}::hinthash;
- \${^WARNING_BITS} = \$${package}::warning_bits;
+ \$^H = \$${package}::HINTS;
+ \%^H = \%\$${package}::HINTHASH;
+ \${^WARNING_BITS} = \$${package}::WARNING_BITS;
}
$line
;
BEGIN {
- \$${package}::hints = \$^H;
- \$${package}::hinthash = \\\%^H;
- \$${package}::warning_bits = \${^WARNING_BITS};
+ \$${package}::HINTS = \$^H;
+ \$${package}::HINTHASH = \\\%^H;
+ \$${package}::WARNING_BITS = \${^WARNING_BITS};
}
LINE
-}
-
-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};
+ method compile ($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 = $hints;
+ our $HINTHASH = $hinthash;
+ our $WARNING_BITS = $warning_bits;
- my @result = $next->($line, %args);
+ my @result = $next->($line, %args);
- $self->{hints} = $hints;
- $self->{hinthash} = $hinthash;
- $self->{warning_bits} = $warning_bits;
+ $hints = $HINTS;
+ $hinthash = $HINTHASH;
+ $warning_bits = $WARNING_BITS;
- return @result;
+ return @result;
+ }
}
1;
diff --git a/lib/Reply/Plugin/Interrupt.pm b/lib/Reply/Plugin/Interrupt.pm
index 1aab2b8..d257785 100644
--- a/lib/Reply/Plugin/Interrupt.pm
+++ b/lib/Reply/Plugin/Interrupt.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Interrupt;
+package main;
use strict;
use warnings;
# ABSTRACT: allows using Ctrl+C to interrupt long-running lines
-use base 'Reply::Plugin';
+use mop;
=head1 SYNOPSIS
@@ -17,20 +17,16 @@ exiting the Reply shell entirely.
=cut
-sub compile {
- my $self = shift;
- my ($next, @args) = @_;
+class Reply::Plugin::Interrupt extends Reply::Plugin {
+ method compile ($next, @args) {
+ local $SIG{INT} = sub { die "Interrupted" };
+ $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);
+ method execute ($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
index 8286aef..415f5a9 100644
--- a/lib/Reply/Plugin/LexicalPersistence.pm
+++ b/lib/Reply/Plugin/LexicalPersistence.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::LexicalPersistence;
+package main;
use strict;
use warnings;
# ABSTRACT: persists lexical variables between lines
-use base 'Reply::Plugin';
+use mop;
use PadWalker 'peek_sub', 'closed_over';
@@ -20,37 +20,21 @@ then use C<$x> as expected in subsequent lines.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::LexicalPersistence extends Reply::Plugin {
+ has $env = {};
- my $self = $class->SUPER::new(@_);
- $self->{env} = {};
+ method compile ($next, $line, %args) {
+ my ($code) = $next->($line, %args);
- return $self;
-}
-
-sub compile {
- my $self = shift;
- my ($next, $line, %args) = @_;
-
- my ($code) = $next->($line, %args);
+ my $new_env = peek_sub($code);
+ delete $new_env->{$_} for keys %{ closed_over($code) };
- my $new_env = peek_sub($code);
- delete $new_env->{$_} for keys %{ closed_over($code) };
-
- $self->{env} = {
- %{ $self->{env} },
- %$new_env,
- };
-
- return $code;
-}
+ $env = { %$env, %$new_env };
-sub lexical_environment {
- my $self = shift;
+ return $code;
+ }
- return $self->{env};
+ method lexical_environment { $env }
}
1;
diff --git a/lib/Reply/Plugin/LoadClass.pm b/lib/Reply/Plugin/LoadClass.pm
index a225cdd..cbffb02 100644
--- a/lib/Reply/Plugin/LoadClass.pm
+++ b/lib/Reply/Plugin/LoadClass.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::LoadClass;
+package main;
use strict;
use warnings;
# ABSTRACT: attempts to load classes implicitly if possible
-use base 'Reply::Plugin';
+use mop;
use Module::Runtime 'use_package_optimistically';
use Try::Tiny;
@@ -23,20 +23,19 @@ be loaded implicitly.
=cut
-sub execute {
- my $self = shift;
- my ($next, @args) = @_;
-
- try {
- $next->(@args);
- }
- catch {
- if (/^Can't locate object method "[^"]*" via package "([^"]*)"/) {
- use_package_optimistically($1);
+class Reply::Plugin::LoadClass extends Reply::Plugin {
+ method execute ($next, @args) {
+ try {
$next->(@args);
}
- else {
- die $_;
+ catch {
+ if (/^Can't locate object method "[^"]*" via package "([^"]*)"/) {
+ use_package_optimistically($1);
+ $next->(@args);
+ }
+ else {
+ die $_;
+ }
}
}
}
diff --git a/lib/Reply/Plugin/Nopaste.pm b/lib/Reply/Plugin/Nopaste.pm
index 7265dc9..8ecf0e1 100644
--- a/lib/Reply/Plugin/Nopaste.pm
+++ b/lib/Reply/Plugin/Nopaste.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Nopaste;
+package main;
use strict;
use warnings;
# ABSTRACT: command to nopaste a transcript of the current session
-use base 'Reply::Plugin';
+use mop;
use App::Nopaste;
@@ -27,79 +27,62 @@ like [DataDump], etc).
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
-
- my $self = $class->SUPER::new(@_);
- $self->{history} = '';
- $self->{service} = $opts{service};
-
- return $self;
-}
-
-sub prompt {
- my $self = shift;
- my ($next, @args) = @_;
- my $prompt = $next->(@args);
- $self->{prompt} = $prompt;
- return $prompt;
-}
-
-sub read_line {
- my $self = shift;
- my ($next, @args) = @_;
- my $line = $next->(@args);
- $self->{line} = "$line\n" if defined $line;
- return $line;
-}
-
-sub print_error {
- my $self = shift;
- my ($next, $error) = @_;
- $self->{result} = $error;
- $next->($error);
-}
-
-sub print_result {
- my $self = shift;
- my ($next, @result) = @_;
- $self->{result} = @result ? join('', @result) . "\n" : '';
- $next->(@result);
-}
-
-sub loop {
- my $self = shift;
- my ($continue) = @_;
-
- my $prompt = delete $self->{prompt};
- my $line = delete $self->{line};
- my $result = delete $self->{result};
-
- $self->{history} .= "$prompt$line$result"
- if defined $prompt
- && defined $line
- && defined $result;
-
- $continue;
-}
-
-sub command_nopaste {
- my $self = shift;
- my ($line) = @_;
-
- $line = "Reply session" unless length $line;
-
- print App::Nopaste->nopaste(
- text => $self->{history},
- desc => $line,
- lang => 'perl',
- (defined $self->{service}
- ? (services => [ $self->{service} ])
- : ()),
- ) . "\n";
-
- return '';
+class Reply::Plugin::Nopaste extends Reply::Plugin {
+ has $history = '';
+ has $service;
+
+ has $prompt;
+ has $line;
+ has $result;
+
+ method prompt ($next, @args) {
+ $prompt = $next->(@args);
+ return $prompt;
+ }
+
+ method read_line ($next, @args) {
+ $line = $next->(@args);
+ $line = "$line\n" if defined $line;
+ return $line;
+ }
+
+ method print_error ($next, $error) {
+ $result = $error;
+ $next->($error);
+ }
+
+ method print_result ($next, @result) {
+ $result = @result ? join('', @result) . "\n" : '';
+ $next->(@result);
+ }
+
+ method loop ($continue) {
+ $history .= "$prompt$line$result"
+ if defined $prompt
+ && defined $line
+ && defined $result;
+
+ undef $prompt;
+ undef $line;
+ undef $result;
+
+ $continue;
+ }
+
+ method command_nopaste ($cmd_line) {
+ $cmd_line = "Reply session" unless length $cmd_line;
+
+ print App::Nopaste->nopaste(
+ text => $history,
+ desc => $cmd_line,
+ lang => 'perl',
+ (defined $service
+ ? (services => [ $service ])
+ : ()),
+ ) . "\n";
+
+ return '';
+ }
}
=for Pod::Coverage
diff --git a/lib/Reply/Plugin/Packages.pm b/lib/Reply/Plugin/Packages.pm
index 75b459e..d2896d4 100644
--- a/lib/Reply/Plugin/Packages.pm
+++ b/lib/Reply/Plugin/Packages.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Packages;
+package main;
use strict;
use warnings;
# ABSTRACT: persist the current package between lines
-use base 'Reply::Plugin';
+use mop;
=head1 SYNOPSIS
@@ -20,47 +20,37 @@ initial package to use when Reply starts up.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::Packages extends Reply::Plugin {
+ has $package = 'main';
- my $self = $class->SUPER::new(@_);
- $self->{package} = $opts{default_package} || 'main';
+ submethod BUILD ($args) {
+ $package = $args->{default_package}
+ if defined $args->{default_package};
+ }
- return $self;
-}
-
-sub mangle_line {
- my $self = shift;
- my ($line) = @_;
-
- my $package = __PACKAGE__;
- return <<LINE;
+ method mangle_line ($line) {
+ my $package = __PACKAGE__;
+ return <<LINE;
$line
;
BEGIN {
- \$${package}::package = __PACKAGE__;
+ \$${package}::PACKAGE = __PACKAGE__;
}
LINE
-}
-
-sub compile {
- my $self = shift;
- my ($next, $line, %args) = @_;
+ }
- my @result = $next->($line, %args);
+ method compile ($next, $line, %args) {
+ my @result = $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
- $self->{package} = our $package;
+ # 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
+ $package = our $PACKAGE;
- return @result;
-}
+ return @result;
+ }
-sub package {
- my $self = shift;
- return $self->{package};
+ method package { $package }
}
1;
diff --git a/lib/Reply/Plugin/ReadLine.pm b/lib/Reply/Plugin/ReadLine.pm
index 55baa38..a33eaea 100644
--- a/lib/Reply/Plugin/ReadLine.pm
+++ b/lib/Reply/Plugin/ReadLine.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::ReadLine;
+package main;
use strict;
use warnings;
# ABSTRACT: use Term::ReadLine for user input
-use base 'Reply::Plugin';
+use mop;
use File::HomeDir;
use File::Spec;
@@ -33,119 +33,111 @@ recommended if possible.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
-
- my $self = $class->SUPER::new(@_);
- $self->{term} = Term::ReadLine->new('Reply');
- my $history = $opts{history_file} || '.reply_history';
- $self->{history_file} = File::Spec->catfile(
- (File::Spec->file_name_is_absolute($history)
- ? ()
- : (File::HomeDir->my_data)),
- $history
- );
-
- $self->{rl_gnu} = $self->{term}->ReadLine eq 'Term::ReadLine::Gnu';
- $self->{rl_perl5} = $self->{term}->ReadLine eq 'Term::ReadLine::Perl5';
- $self->{rl_caroline} = $self->{term}->ReadLine eq 'Term::ReadLine::Caroline';
-
- if ($self->{rl_perl5}) {
- # output compatible with Term::ReadLine::Gnu
- $readline::rl_scroll_nextline = 0;
- }
-
- if ($self->{rl_perl5} || $self->{rl_gnu} || $self->{rl_caroline}) {
- $self->{term}->StifleHistory($opts{history_length})
- if defined $opts{history_length} && $opts{history_length} >= 0;
- }
-
- if (open my $fh, '<', $self->{history_file}) {
- for my $line (<$fh>) {
- chomp $line;
- $self->{term}->addhistory($line);
+class Reply::Plugin::ReadLine extends Reply::Plugin {
+ has $term = Term::ReadLine->new('Reply');
+ has $history_file = '.reply_history';
+ has $history_length = -1;
+
+ # XXX these should be able to be lazy, but defaults can't see attributes
+ # yet it seems
+ has $rl_gnu;
+ has $rl_perl5;
+ has $rl_caroline;
+
+ submethod BUILD ($opts) {
+ $rl_gnu = $term->ReadLine eq 'Term::ReadLine::Gnu';
+ $rl_perl5 = $term->ReadLine eq 'Term::ReadLine::Perl5';
+ $rl_caroline = $term->ReadLine eq 'Term::ReadLine::Caroline';
+
+ $history_file = File::Spec->catfile(
+ (File::Spec->file_name_is_absolute($history_file)
+ ? ()
+ : (File::HomeDir->my_data)),
+ $history_file
+ );
+
+ if ($rl_perl5) {
+ # output compatible with Term::ReadLine::Gnu
+ $readline::rl_scroll_nextline = 0;
}
- }
- else {
- my $e = $!;
- warn "Couldn't open $self->{history_file} for reading: $e"
- if -e $self->{history_file};
- }
-
- $self->_register_tab_complete;
- return $self;
-}
+ if ($rl_perl5 || $rl_gnu || $rl_caroline) {
+ $term->StifleHistory($history_length)
+ if $history_length >= 0;
+ }
-sub read_line {
- my $self = shift;
- my ($next, $prompt) = @_;
+ if (open my $fh, '<', $history_file) {
+ for my $line (<$fh>) {
+ chomp $line;
+ $term->addhistory($line);
+ }
+ }
+ else {
+ my $e = $!;
+ warn "Couldn't open $history_file for reading: $e"
+ if -e $history_file;
+ }
- return $self->{term}->readline($prompt);
-}
+ $self->_register_tab_complete;
+ }
-sub DESTROY {
- my $self = shift;
+ method read_line ($next, $prompt) {
+ $term->readline($prompt);
+ }
- return if defined $self->{history_length} && $self->{history_length} == 0;
+ submethod DEMOLISH {
+ return if $history_length == 0;
+ return unless $rl_gnu || $rl_perl5;
+ $term->WriteHistory($history_file)
+ or warn "Couldn't write history to $history_file";
+ }
- # XXX support more later
- return unless ($self->{rl_gnu} || $self->{rl_perl5} || $self->{rl_caroline});
+ method _register_tab_complete {
+ weaken(my $weakself = $self);
- $self->{term}->WriteHistory($self->{history_file})
- or warn "Couldn't write history to $self->{history_file}";
-}
+ if ($rl_gnu) {
+ $term->Attribs->{attempted_completion_function} = sub {
+ my ($text, $line, $start, $end) = @_;
-sub _register_tab_complete {
- my $self = shift;
+ # discard everything after the cursor for completion purposes
+ substr($line, $end) = '';
- my $term = $self->{term};
+ my @matches = $weakself->publish('tab_handler', $line);
+ my $match_index = 0;
- weaken(my $weakself = $self);
+ return $term->completion_matches($text, sub {
+ my ($text, $index) = @_;
+ return $matches[$index];
+ });
+ };
+ }
- if ($self->{rl_gnu}) {
- $term->Attribs->{attempted_completion_function} = sub {
- my ($text, $line, $start, $end) = @_;
+ if ($rl_perl5) {
+ $term->Attribs->{completion_function} = sub {
+ my ($text, $line, $start) = @_;
+ my $end = $start + length($text);
- # discard everything after the cursor for completion purposes
- substr($line, $end) = '';
+ # discard everything after the cursor for completion purposes
+ substr($line, $end) = '';
- my @matches = $weakself->publish('tab_handler', $line);
- my $match_index = 0;
+ my @matches = $weakself->publish('tab_handler', $line);
+ return scalar(@matches) ? @matches : ();
+ };
+ }
- return $term->completion_matches($text, sub {
- my ($text, $index) = @_;
- return $matches[$index];
+ if ($rl_caroline) {
+ $term->caroline->completion_callback(sub {
+ my ($line) = @_;
+
+ my @matches = $weakself->publish('tab_handler', $line);
+ # for variable completion, method name completion.
+ if (@matches && $line =~ /\W/) {
+ $line =~ s/[:\w]+\z//;
+ @matches = map { $line.$_ } @matches;
+ }
+ return scalar(@matches) ? @matches : ();
});
- };
- }
-
- if ($self->{rl_perl5}) {
- $term->Attribs->{completion_function} = sub {
- my ($text, $line, $start) = @_;
- my $end = $start + length($text);
-
- # discard everything after the cursor for completion purposes
- substr($line, $end) = '';
-
- my @matches = $weakself->publish('tab_handler', $line);
- return scalar(@matches) ? @matches : ();
- };
- }
-
- if ($self->{rl_caroline}) {
- $term->caroline->completion_callback(sub {
- my ($line) = @_;
-
- my @matches = $weakself->publish('tab_handler', $line);
- # for variable completion, method name completion.
- if (@matches && $line =~ /\W/) {
- $line =~ s/[:\w]+\z//;
- @matches = map { $line.$_ } @matches;
- }
- return scalar(@matches) ? @matches : ();
- });
+ }
}
}
diff --git a/lib/Reply/Plugin/ResultCache.pm b/lib/Reply/Plugin/ResultCache.pm
index b7b929b..0407a68 100644
--- a/lib/Reply/Plugin/ResultCache.pm
+++ b/lib/Reply/Plugin/ResultCache.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::ResultCache;
+package main;
use strict;
use warnings;
# ABSTRACT: retain previous results to be able to refer to them later
-use base 'Reply::Plugin';
+use mop;
=head1 SYNOPSIS
@@ -21,44 +21,30 @@ include an indication of where the value is stored, for later reference.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::ResultCache extends Reply::Plugin {
+ has $results = [];
+ has $variable = 'res';
- my $self = $class->SUPER::new(@_);
- $self->{results} = [];
- $self->{result_name} = $opts{variable} || 'res';
+ method execute ($next, @args) {
+ my @res = $next->(@args);
+ if (@res == 1) {
+ push @$results, $res[0];
+ }
+ elsif (@res > 1) {
+ push @$results, \@res;
+ }
- return $self;
-}
-
-sub execute {
- my $self = shift;
- my ($next, @args) = @_;
-
- my @res = $next->(@args);
- if (@res == 1) {
- push @{ $self->{results} }, $res[0];
+ return @res;
}
- elsif (@res > 1) {
- push @{ $self->{results} }, \@res;
- }
-
- return @res;
-}
-
-sub mangle_result {
- my $self = shift;
- my ($result) = @_;
- return unless defined $result;
- return '$' . $self->{result_name} . '[' . $#{ $self->{results} } . '] = '
- . $result;
-}
+ method mangle_result ($result) {
+ return unless defined $result;
+ return '$' . $variable . '[' . $#$results . '] = ' . $result;
+ }
-sub lexical_environment {
- my $self = shift;
- return { "\@$self->{result_name}" => [ @{ $self->{results} } ] };
+ method lexical_environment {
+ return { "\@$variable" => [ @$results ] };
+ }
}
1;
diff --git a/lib/Reply/Plugin/Timer.pm b/lib/Reply/Plugin/Timer.pm
index a3ec247..bef91d7 100644
--- a/lib/Reply/Plugin/Timer.pm
+++ b/lib/Reply/Plugin/Timer.pm
@@ -1,9 +1,9 @@
-package Reply::Plugin::Timer;
+package main;
use strict;
use warnings;
# ABSTRACT: time commands
-use base 'Reply::Plugin';
+use mop;
use Time::HiRes qw(gettimeofday tv_interval);
@@ -20,33 +20,24 @@ the default C<mintime> is C<< 0.01 >> seconds.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
+class Reply::Plugin::Timer extends Reply::Plugin {
+ has $mintime = 0.01;
- my $self = $class->SUPER::new(@_);
- $self->{mintime} = $opts{mintime} || 0.01;
+ method execute ($next, @args) {
+ my $t0 = [gettimeofday];
+ my $ret = $next->(@args);
+ my $elapsed = tv_interval($t0);
- return $self;
-}
-
-
-sub execute {
- my ($self, $next, @args) = @_;
-
- my $t0 = [gettimeofday];
- my $ret = $next->(@args);
- my $elapsed = tv_interval($t0);
-
- if ($elapsed > $self->{mintime}) {
- if ($elapsed >= 1) {
- printf "Execution Time: %0.3fs\n", $elapsed
- } else {
- printf "Execution Time: %dms\n", $elapsed * 1000
+ if ($elapsed > $mintime) {
+ if ($elapsed >= 1) {
+ printf "Execution Time: %0.3fs\n", $elapsed
+ } else {
+ printf "Execution Time: %dms\n", $elapsed * 1000
+ }
}
- }
- return $ret;
+ return $ret;
+ }
}
1;