From 34ef46f40b283ae69f315fcefc1bf8297d2ec8d2 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 7 Aug 2013 14:17:21 -0400
Subject: convert main reply class

---
 lib/Reply.pm | 306 ++++++++++++++++++++++++++---------------------------------
 1 file changed, 132 insertions(+), 174 deletions(-)

(limited to 'lib')

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
-- 
cgit v1.2.3-54-g00ecf