From 3e19fb26f62ce9fa02e417c015f6668989d1eaad Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 7 Aug 2013 22:28:04 -0400 Subject: convert all of the plugins --- lib/Reply/Plugin/AutoRefresh.pm | 49 ++++---- lib/Reply/Plugin/Autocomplete/Commands.pm | 19 ++- lib/Reply/Plugin/Autocomplete/Functions.pm | 51 ++++---- lib/Reply/Plugin/Autocomplete/Globals.pm | 101 +++++++-------- lib/Reply/Plugin/Autocomplete/Keywords.pm | 27 ++-- lib/Reply/Plugin/Autocomplete/Lexicals.pm | 55 ++++----- lib/Reply/Plugin/Autocomplete/Methods.pm | 63 +++++----- lib/Reply/Plugin/Autocomplete/Packages.pm | 24 ++-- lib/Reply/Plugin/CollapseStack.pm | 69 ++++------- lib/Reply/Plugin/Colors.pm | 91 ++++++-------- lib/Reply/Plugin/DataDump.pm | 29 ++--- lib/Reply/Plugin/DataDumper.pm | 24 ++-- lib/Reply/Plugin/DataPrinter.pm | 11 +- lib/Reply/Plugin/Defaults.pm | 105 ++++++---------- lib/Reply/Plugin/Editor.pm | 80 ++++++------ lib/Reply/Plugin/FancyPrompt.pm | 35 +++--- lib/Reply/Plugin/Hints.pm | 71 +++++------ lib/Reply/Plugin/Interrupt.pm | 26 ++-- lib/Reply/Plugin/LexicalPersistence.pm | 40 ++---- lib/Reply/Plugin/LoadClass.pm | 27 ++-- lib/Reply/Plugin/Nopaste.pm | 133 +++++++++----------- lib/Reply/Plugin/Packages.pm | 54 ++++---- lib/Reply/Plugin/ReadLine.pm | 190 ++++++++++++++--------------- lib/Reply/Plugin/ResultCache.pm | 56 ++++----- lib/Reply/Plugin/Timer.pm | 41 +++---- 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 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 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 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 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 ; -} - (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 ; + } - 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 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 <{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, %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 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; -- cgit v1.2.3