summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-08-07 14:17:21 -0400
committerJesse Luehrs <doy@tozt.net>2013-09-03 16:50:14 -0400
commit34ef46f40b283ae69f315fcefc1bf8297d2ec8d2 (patch)
tree3ed2a2873d917e47007a9c84029ad020f4148b0f
parent7989b47c92e7dbd6f43114d8e43aff8c31f79584 (diff)
downloadreply-34ef46f40b283ae69f315fcefc1bf8297d2ec8d2.tar.gz
reply-34ef46f40b283ae69f315fcefc1bf8297d2ec8d2.zip
convert main reply class
-rw-r--r--lib/Reply.pm306
1 files changed, 132 insertions, 174 deletions
diff --git a/lib/Reply.pm b/lib/Reply.pm
index e4c663e..4261109 100644
--- a/lib/Reply.pm
+++ b/lib/Reply.pm
@@ -1,8 +1,10 @@
-package Reply;
+package main;
use strict;
use warnings;
# ABSTRACT: read, eval, print, loop, yay!
+use mop;
+
use Module::Runtime qw(compose_module_name require_module);
use Scalar::Util qw(blessed weaken);
use Try::Tiny;
@@ -77,26 +79,20 @@ An arrayref of additional plugins to load.
=cut
-sub new {
- my $class = shift;
- my %opts = @_;
-
- my $self = bless {}, $class;
+class Reply {
+ has $plugins = [];
+ has $_default_plugin = $_->_instantiate_plugin('Defaults');
- $self->{plugins} = [];
- $self->{_default_plugin} = $self->_instantiate_plugin('Defaults');
-
- if (defined $opts{config}) {
- if (!ref($opts{config})) {
- $opts{config} = Reply::Config->new(file => $opts{config});
+ submethod BUILD ($opts) {
+ if (defined $opts->{config}) {
+ if (!ref($opts->{config})) {
+ $opts->{config} = Reply::Config->new(file => $opts->{config});
+ }
+ $self->_load_config($opts->{config});
}
- $self->_load_config($opts{config});
- }
- $self->_load_plugin($_) for @{ $opts{plugins} || [] };
-
- return $self;
-}
+ $self->_load_plugin($_) for @{ $opts->{plugins} || [] };
+ }
=method run
@@ -106,15 +102,13 @@ returns false (by default, the C<#q> command quits the repl in this way).
=cut
-sub run {
- my $self = shift;
-
- while (1) {
- my $continue = $self->step;
- last unless $continue;
+ method run {
+ while (1) {
+ my $continue = $self->step;
+ last unless $continue;
+ }
+ print "\n";
}
- print "\n";
-}
=method step($line)
@@ -125,199 +119,163 @@ requested to quit.
=cut
-sub step {
- my $self = shift;
- my ($line) = @_;
+ method step ($line) {
+ # XXX $self should be available in parameter defaults too
+ $line = $self->_read unless defined $line;
- $line = $self->_read unless defined $line;
+ return unless defined $line;
- return unless defined $line;
+ $line = $self->_preprocess_line($line);
- $line = $self->_preprocess_line($line);
+ try {
+ my @result = $self->_eval($line);
+ $self->_print_result(@result);
+ }
+ catch {
+ $self->_print_error($_);
+ };
- try {
- my @result = $self->_eval($line);
- $self->_print_result(@result);
+ my ($continue) = $self->_loop;
+ return $continue;
}
- catch {
- $self->_print_error($_);
- };
-
- my ($continue) = $self->_loop;
- return $continue;
-}
-sub _load_config {
- my $self = shift;
- my ($config) = @_;
-
- my $data = $config->data;
+ method _load_config ($config) {
+ my $data = $config->data;
+
+ my $root_config;
+ for my $section (@$data) {
+ my ($name, $data) = @$section;
+ if ($name eq '_') {
+ $root_config = $data;
+ }
+ else {
+ $self->_load_plugin($name => $data);
+ }
+ }
- my $root_config;
- for my $section (@$data) {
- my ($name, $data) = @$section;
- if ($name eq '_') {
- $root_config = $data;
+ for my $line (sort grep { /^script_line/ } keys %$root_config) {
+ $self->step($root_config->{$line});
}
- else {
- $self->_load_plugin($name => $data);
+
+ if (defined(my $file = $root_config->{script_file})) {
+ my $contents = do {
+ open my $fh, '<', $file or die "Couldn't open $file: $!";
+ local $/ = undef;
+ <$fh>
+ };
+ $self->step($contents);
}
}
- for my $line (sort grep { /^script_line/ } keys %$root_config) {
- $self->step($root_config->{$line});
- }
+ method _load_plugin ($plugin, $opts) {
+ $plugin = $self->_instantiate_plugin($plugin, $opts);
- if (defined(my $file = $root_config->{script_file})) {
- my $contents = do {
- open my $fh, '<', $file or die "Couldn't open $file: $!";
- local $/ = undef;
- <$fh>
- };
- $self->step($contents);
+ push @$plugins, $plugin;
}
-}
-
-sub _load_plugin {
- my $self = shift;
- my ($plugin, $opts) = @_;
- $plugin = $self->_instantiate_plugin($plugin, $opts);
+ method _instantiate_plugin ($plugin, $opts) {
+ if (!blessed($plugin)) {
+ $plugin = compose_module_name("Reply::Plugin", $plugin);
+ require_module($plugin);
+ die "$plugin is not a valid plugin"
+ unless $plugin->isa("Reply::Plugin");
- push @{ $self->{plugins} }, $plugin;
-}
-
-sub _instantiate_plugin {
- my $self = shift;
- my ($plugin, $opts) = @_;
+ my $weakself = $self;
+ weaken($weakself);
- if (!blessed($plugin)) {
- $plugin = compose_module_name("Reply::Plugin", $plugin);
- require_module($plugin);
- die "$plugin is not a valid plugin"
- unless $plugin->isa("Reply::Plugin");
-
- my $weakself = $self;
- weaken($weakself);
+ $plugin = $plugin->new(
+ %$opts,
+ publisher => sub { $weakself->_publish(@_) },
+ );
+ }
- $plugin = $plugin->new(
- %$opts,
- publisher => sub { $weakself->_publish(@_) },
- );
+ return $plugin;
}
- return $plugin;
-}
-
-sub _plugins {
- my $self = shift;
-
- return (
- @{ $self->{plugins} },
- $self->{_default_plugin},
- );
-}
-
-sub _read {
- my $self = shift;
-
- my $prompt = $self->_wrapped_plugin('prompt');
- return $self->_wrapped_plugin('read_line', $prompt);
-}
-
-sub _preprocess_line {
- my $self = shift;
- my ($line) = @_;
-
- if ($line =~ s/^#(\w+)(?:\s+|$)//) {
- ($line) = $self->_chained_plugin("command_\L$1", $line);
+ method _plugins {
+ return (@$plugins, $_default_plugin);
}
- return "\n#line 1 \"reply input\"\n$line";
-}
-
-sub _eval {
- my $self = shift;
- my ($line) = @_;
-
- ($line) = $self->_chained_plugin('mangle_line', $line)
- if defined $line;
+ method _read {
+ my $prompt = $self->_wrapped_plugin('prompt');
+ return $self->_wrapped_plugin('read_line', [$prompt]);
+ }
- my ($code) = $self->_wrapped_plugin('compile', $line);
- return $self->_wrapped_plugin('execute', $code);
-}
+ method _preprocess_line ($line) {
+ if ($line =~ s/^#(\w+)(?:\s+|$)//) {
+ ($line) = $self->_chained_plugin("command_\L$1", [$line]);
+ }
-sub _print_error {
- my $self = shift;
- my ($error) = @_;
+ return "\n#line 1 \"reply input\"\n$line";
+ }
- ($error) = $self->_chained_plugin('mangle_error', $error);
- $self->_wrapped_plugin('print_error', $error);
-}
+ method _eval ($line) {
+ ($line) = $self->_chained_plugin('mangle_line', [$line])
+ if defined $line;
-sub _print_result {
- my $self = shift;
- my (@result) = @_;
+ my ($code) = $self->_wrapped_plugin('compile', [$line]);
+ return $self->_wrapped_plugin('execute', [$code]);
+ }
- @result = $self->_chained_plugin('mangle_result', @result);
- $self->_wrapped_plugin('print_result', @result);
-}
+ method _print_error ($error) {
+ ($error) = $self->_chained_plugin('mangle_error', [$error]);
+ $self->_wrapped_plugin('print_error', [$error]);
+ }
-sub _loop {
- my $self = shift;
+ method _print_result (@result) {
+ @result = $self->_chained_plugin('mangle_result', \@result);
+ $self->_wrapped_plugin('print_result', \@result);
+ }
- $self->_chained_plugin('loop', 1);
-}
+ method _loop {
+ $self->_chained_plugin('loop', [1]);
+ }
-sub _publish {
- my $self = shift;
+ method _publish ($method, @args) {
+ $self->_concatenate_plugin($method, \@args);
+ }
- $self->_concatenate_plugin(@_);
-}
+ method _wrapped_plugin ($method, $args = [], $plugins = undef) {
+ # XXX $self should be available in parameter defaults too
+ $plugins //= [ $self->_plugins ];
-sub _wrapped_plugin {
- my $self = shift;
- my @plugins = ref($_[0]) ? @{ shift() } : $self->_plugins;
- my ($method, @args) = @_;
+ $plugins = [ grep { $_->can($method) } @$plugins ];
- @plugins = grep { $_->can($method) } @plugins;
+ return @$args unless @$plugins;
- return @args unless @plugins;
+ my $plugin = shift @$plugins;
+ my $next = sub { $self->_wrapped_plugin($method, [@_], $plugins) };
- my $plugin = shift @plugins;
- my $next = sub { $self->_wrapped_plugin(\@plugins, $method, @_) };
+ return $plugin->$method($next, @$args);
+ }
- return $plugin->$method($next, @args);
-}
+ method _chained_plugin ($method, $args = [], $plugins = undef) {
+ # XXX $self should be available in parameter defaults too
+ $plugins //= [ $self->_plugins ];
-sub _chained_plugin {
- my $self = shift;
- my @plugins = ref($_[0]) ? @{ shift() } : $self->_plugins;
- my ($method, @args) = @_;
+ $plugins = [ grep { $_->can($method) } @$plugins ];
- @plugins = grep { $_->can($method) } @plugins;
+ for my $plugin (@$plugins) {
+ @$args = $plugin->$method(@$args);
+ }
- for my $plugin (@plugins) {
- @args = $plugin->$method(@args);
+ return @$args;
}
- return @args;
-}
+ method _concatenate_plugin ($method, $args = [], $plugins = undef) {
+ # XXX $self should be available in parameter defaults too
+ $plugins //= [ $self->_plugins ];
-sub _concatenate_plugin {
- my $self = shift;
- my @plugins = ref($_[0]) ? @{ shift() } : $self->_plugins;
- my ($method, @args) = @_;
+ $plugins = [ grep { $_->can($method) } @$plugins ];
- @plugins = grep { $_->can($method) } @plugins;
+ my @results;
- my @results;
+ for my $plugin (@$plugins) {
+ push @results, $plugin->$method(@$args);
+ }
- for my $plugin (@plugins) {
- push @results, $plugin->$method(@args);
+ return @results;
}
-
- return @results;
}
=head1 BUGS