summaryrefslogtreecommitdiffstats
path: root/lib/Reply/Plugin
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Reply/Plugin')
-rw-r--r--lib/Reply/Plugin/Colors.pm66
-rw-r--r--lib/Reply/Plugin/DataDump.pm15
-rw-r--r--lib/Reply/Plugin/DataDumper.pm15
-rw-r--r--lib/Reply/Plugin/Defaults.pm64
-rw-r--r--lib/Reply/Plugin/FancyPrompt.pm20
-rw-r--r--lib/Reply/Plugin/Hints.pm55
-rw-r--r--lib/Reply/Plugin/Interrupt.pm23
-rw-r--r--lib/Reply/Plugin/LexicalPersistence.pm31
-rw-r--r--lib/Reply/Plugin/LoadClass.pm28
-rw-r--r--lib/Reply/Plugin/Packages.pm39
-rw-r--r--lib/Reply/Plugin/ReadLine.pm25
11 files changed, 381 insertions, 0 deletions
diff --git a/lib/Reply/Plugin/Colors.pm b/lib/Reply/Plugin/Colors.pm
new file mode 100644
index 0000000..199d41e
--- /dev/null
+++ b/lib/Reply/Plugin/Colors.pm
@@ -0,0 +1,66 @@
+package Reply::Plugin::Colors;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Term::ANSIColor;
+
+sub new {
+ my $class = shift;
+
+ my $self = $class->SUPER::new(@_);
+ $self->{error} = 'red';
+ $self->{warning} = 'yellow';
+ $self->{result} = 'green';
+
+ return $self;
+}
+
+sub compile {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ local $SIG{__WARN__} = sub { $self->print_warn(@_) };
+ $next->(@args);
+}
+
+sub execute {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ local $SIG{__WARN__} = sub { $self->print_warn(@_) };
+ $next->(@args);
+}
+
+sub print_error {
+ my $self = shift;
+ my ($next, $error) = @_;
+
+ print color($self->{error});
+ $next->($error);
+ local $| = 1;
+ print color('reset');
+}
+
+sub print_result {
+ my $self = shift;
+ my ($next, @result) = @_;
+
+ print color($self->{result});
+ $next->(@result);
+ local $| = 1;
+ print color('reset');
+}
+
+sub print_warn {
+ my $self = shift;
+ my ($warning) = @_;
+
+ print color($self->{warning});
+ print $warning;
+ local $| = 1;
+ print color('reset');
+}
+
+1;
diff --git a/lib/Reply/Plugin/DataDump.pm b/lib/Reply/Plugin/DataDump.pm
new file mode 100644
index 0000000..e80deab
--- /dev/null
+++ b/lib/Reply/Plugin/DataDump.pm
@@ -0,0 +1,15 @@
+package Reply::Plugin::DataDump;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Data::Dump 'pp';
+
+sub mangle_result {
+ my $self = shift;
+ my (@result) = @_;
+ return @result ? pp(@result) : ();
+}
+
+1;
diff --git a/lib/Reply/Plugin/DataDumper.pm b/lib/Reply/Plugin/DataDumper.pm
new file mode 100644
index 0000000..676344a
--- /dev/null
+++ b/lib/Reply/Plugin/DataDumper.pm
@@ -0,0 +1,15 @@
+package Reply::Plugin::DataDumper;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Data::Dumper;
+
+sub mangle_result {
+ my $self = shift;
+ my (@result) = @_;
+ return Dumper(@result);
+}
+
+1;
diff --git a/lib/Reply/Plugin/Defaults.pm b/lib/Reply/Plugin/Defaults.pm
new file mode 100644
index 0000000..507c830
--- /dev/null
+++ b/lib/Reply/Plugin/Defaults.pm
@@ -0,0 +1,64 @@
+package Reply::Plugin::Defaults;
+
+# XXX Eval::Closure imposes its own hints on things that are eval'ed at the
+# moment, but this may be fixed in the future
+BEGIN {
+ our $default_hints = $^H;
+ our $default_hinthash = { %^H };
+ our $default_warning_bits = ${^WARNING_BITS};
+}
+
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Eval::Closure;
+
+sub prompt { "> " }
+
+sub read_line {
+ my $self = shift;
+ my ($next, $prompt) = @_;
+
+ print $prompt;
+ return scalar <>;
+}
+
+my $PREFIX = "package main; BEGIN { \$^H = \$" . __PACKAGE__ . "::default_hints; \%^H = \%\$" . __PACKAGE__ . "::default_hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::default_warning_bits }";
+
+sub compile {
+ my $self = shift;
+ my ($next, $line, %args) = @_;
+
+ return eval_closure(
+ source => "sub { $PREFIX; $line }",
+ terse_error => 1,
+ %args,
+ );
+}
+
+sub execute {
+ my $self = shift;
+ my ($next, $code) = @_;
+
+ return $code->();
+}
+
+sub print_error {
+ my $self = shift;
+ my ($next, $error) = @_;
+
+ print $error
+ if defined $error;
+}
+
+sub print_result {
+ my $self = shift;
+ my ($next, @result) = @_;
+
+ print @result, "\n"
+ if @result;
+}
+
+1;
diff --git a/lib/Reply/Plugin/FancyPrompt.pm b/lib/Reply/Plugin/FancyPrompt.pm
new file mode 100644
index 0000000..aec5b82
--- /dev/null
+++ b/lib/Reply/Plugin/FancyPrompt.pm
@@ -0,0 +1,20 @@
+package Reply::Plugin::FancyPrompt;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->{counter} = 0;
+ return $self;
+}
+
+sub prompt {
+ my $self = shift;
+ my ($next) = @_;
+ return $self->{counter}++ . $next->();
+}
+
+1;
diff --git a/lib/Reply/Plugin/Hints.pm b/lib/Reply/Plugin/Hints.pm
new file mode 100644
index 0000000..ea0e953
--- /dev/null
+++ b/lib/Reply/Plugin/Hints.pm
@@ -0,0 +1,55 @@
+package Reply::Plugin::Hints;
+
+my $default_hints;
+my $default_hinthash;
+my $default_warning_bits;
+BEGIN {
+ $default_hints = $^H;
+ $default_hinthash = \%^H;
+ $default_warning_bits = ${^WARNING_BITS};
+}
+
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+sub new {
+ my $class = shift;
+
+ my $self = $class->SUPER::new(@_);
+ $self->{hints} = $default_hints;
+ $self->{hinthash} = $default_hinthash;
+ $self->{warning_bits} = $default_warning_bits;
+
+ return $self;
+}
+
+sub mangle_line {
+ my $self = shift;
+ my ($line) = @_;
+
+ return "BEGIN { \$^H = \$" . __PACKAGE__ . "::hints; \%^H = \%\$" . __PACKAGE__ . "::hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::warning_bits } $line; BEGIN { \$" . __PACKAGE__ . "::hints = \$^H; \$" . __PACKAGE__ . "::hinthash = \\\%^H; \$" . __PACKAGE__ . "::warning_bits = \${^WARNING_BITS} }";
+}
+
+sub compile {
+ my $self = shift;
+ my ($next, $line, %args) = @_;
+
+ # XXX it'd be nice to avoid using globals here, but we can't use
+ # eval_closure's environment parameter since we need to access the
+ # information in a BEGIN block
+ our $hints = $self->{hints};
+ our $hinthash = $self->{hinthash};
+ our $warning_bits = $self->{warning_bits};
+
+ my @result = $next->($line, %args);
+
+ $self->{hints} = $hints;
+ $self->{hinthash} = $hinthash;
+ $self->{warning_bits} = $warning_bits;
+
+ return @result;
+}
+
+1;
diff --git a/lib/Reply/Plugin/Interrupt.pm b/lib/Reply/Plugin/Interrupt.pm
new file mode 100644
index 0000000..a5c2b37
--- /dev/null
+++ b/lib/Reply/Plugin/Interrupt.pm
@@ -0,0 +1,23 @@
+package Reply::Plugin::Interrupt;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+sub compile {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ local $SIG{INT} = sub { die "Interrupted" };
+ $next->(@args);
+}
+
+sub execute {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ local $SIG{INT} = sub { die "Interrupted" };
+ $next->(@args);
+}
+
+1;
diff --git a/lib/Reply/Plugin/LexicalPersistence.pm b/lib/Reply/Plugin/LexicalPersistence.pm
new file mode 100644
index 0000000..0540f96
--- /dev/null
+++ b/lib/Reply/Plugin/LexicalPersistence.pm
@@ -0,0 +1,31 @@
+package Reply::Plugin::LexicalPersistence;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Lexical::Persistence;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->{env} = Lexical::Persistence->new;
+ return $self;
+}
+
+sub compile {
+ my $self = shift;
+ my ($next, $line, %args) = @_;
+
+ my %c = %{ $self->{env}->get_context('_') };
+
+ $args{environment} ||= {};
+ $args{environment} = {
+ %{ $args{environment} },
+ (map { $_ => ref($c{$_}) ? $c{$_} : \$c{$_} } keys %c),
+ };
+ my ($code) = $next->($line, %args);
+ return $self->{env}->wrap($code);
+}
+
+1;
diff --git a/lib/Reply/Plugin/LoadClass.pm b/lib/Reply/Plugin/LoadClass.pm
new file mode 100644
index 0000000..8bba634
--- /dev/null
+++ b/lib/Reply/Plugin/LoadClass.pm
@@ -0,0 +1,28 @@
+package Reply::Plugin::LoadClass;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Module::Runtime 'use_package_optimistically';
+use Try::Tiny;
+
+sub execute {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ try {
+ $next->(@args);
+ }
+ catch {
+ if (/^Can't locate object method "[^"]*" via package "([^"]*)"/) {
+ use_package_optimistically($1);
+ $next->(@args);
+ }
+ else {
+ die $_;
+ }
+ }
+}
+
+1;
diff --git a/lib/Reply/Plugin/Packages.pm b/lib/Reply/Plugin/Packages.pm
new file mode 100644
index 0000000..6f3e32c
--- /dev/null
+++ b/lib/Reply/Plugin/Packages.pm
@@ -0,0 +1,39 @@
+package Reply::Plugin::Packages;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+sub new {
+ my $class = shift;
+
+ my $self = $class->SUPER::new(@_);
+ $self->{package} = 'main';
+
+ return $self;
+}
+
+sub mangle_line {
+ my $self = shift;
+ my ($line) = @_;
+
+ return "package $self->{package}; $line; BEGIN { \$" . __PACKAGE__ . "::package = __PACKAGE__ }";
+}
+
+sub compile {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ # XXX it'd be nice to avoid using globals here, but we can't use
+ # eval_closure's environment parameter since we need to access the
+ # information in a BEGIN block
+ our $package = $self->{package};
+
+ my @result = $next->(@args);
+
+ $self->{package} = $package;
+
+ return @result;
+}
+
+1;
diff --git a/lib/Reply/Plugin/ReadLine.pm b/lib/Reply/Plugin/ReadLine.pm
new file mode 100644
index 0000000..dc9c617
--- /dev/null
+++ b/lib/Reply/Plugin/ReadLine.pm
@@ -0,0 +1,25 @@
+package Reply::Plugin::ReadLine;
+use strict;
+use warnings;
+
+use base 'Reply::Plugin';
+
+use Term::ReadLine;
+
+sub new {
+ my $class = shift;
+
+ my $self = $class->SUPER::new(@_);
+ $self->{term} = Term::ReadLine->new('Reply');
+
+ return $self;
+}
+
+sub read_line {
+ my $self = shift;
+ my ($next, $prompt) = @_;
+
+ return $self->{term}->readline($prompt);
+}
+
+1;
generated by cgit v1.2.3-54-g00ecf (git 2.45.0) at 2024-05-23 21:53:02 +0000