factor out the callback stuff, make Term::Filter a role

6 files changed, 83 insertions, 46 deletions

diff --git a/lib/Term/Filter.pm b/lib/Term/Filter.pm
index 3f161a1..8032d20 100644
--- a/lib/Term/Filter.pm
+++ b/lib/Term/Filter.pm
@@ -1,5 +1,5 @@
 package Term::Filter;
-use Moose;
+use Moose::Role;
 # ABSTRACT: Run an interactive terminal session, filtering the input and output
 
 use IO::Pty::Easy ();
@@ -19,30 +19,6 @@ subtype     'Term::Filter::TtyFileHandle',
     where   { -t $_ },
     message { "Term::Filter requires input and output filehandles to be attached to a terminal" };
 
-=attr callbacks
-
-=cut
-
-has callbacks => (
-    is      => 'ro',
-    isa     => 'HashRef[CodeRef]',
-    default => sub { {} },
-);
-
-sub _callback {
-    my $self = shift;
-    my ($event, @args) = @_;
-    my $callback = $self->callbacks->{$event};
-    return unless $callback;
-    return $self->$callback(@args);
-}
-
-sub _has_callback {
-    my $self = shift;
-    my ($event) = @_;
-    return exists $self->callbacks->{$event};
-}
-
 =attr input
 
 =cut
@@ -168,7 +144,7 @@ sub run {
         );
 
         for my $fh (@$e) {
-            $self->_callback('read_error', $fh);
+            $self->read_error($fh);
         }
 
         for my $fh (@$r) {
@@ -176,8 +152,7 @@ sub run {
                 my $got = $self->_read_from_handle($self->input, "STDIN");
                 last LOOP unless defined $got;
 
-                $got = $self->_callback('munge_input', $got)
-                    if $self->_has_callback('munge_input');
+                $got = $self->munge_input($got);
 
                 # XXX should i select here, or buffer, to make sure this
                 # doesn't block?
@@ -187,15 +162,14 @@ sub run {
                 my $got = $self->_read_from_handle($self->pty, "pty");
                 last LOOP unless defined $got;
 
-                $got = $self->_callback('munge_output', $got)
-                    if $self->_has_callback('munge_output');
+                $got = $self->munge_output($got);
 
                 # XXX should i select here, or buffer, to make sure this
                 # doesn't block?
                 syswrite $self->output, $got;
             }
             else {
-                $self->_callback('read', $fh);
+                $self->read($fh);
             }
         }
     }
@@ -218,7 +192,7 @@ sub _setup {
 
         $self->pty->kill('WINCH', 1);
 
-        $self->_callback('winch');
+        $self->winch;
 
         $prev_winch->();
     };
@@ -227,10 +201,10 @@ sub _setup {
     my $guard = Scope::Guard->new(sub {
         $SIG{WINCH} = $prev_winch;
         $self->_raw_mode(0);
-        $self->_callback('cleanup') if $setup_called;
+        $self->cleanup if $setup_called;
     });
 
-    $self->_callback('setup', @cmd);
+    $self->setup(@cmd);
     $setup_called = 1;
 
     return $guard;
@@ -251,8 +225,15 @@ sub _read_from_handle {
     return $buf;
 }
 
-__PACKAGE__->meta->make_immutable;
-no Moose;
+sub setup        { }
+sub cleanup      { }
+sub munge_input  { $_[1] }
+sub munge_output { $_[1] }
+sub read         { }
+sub read_error   { }
+sub winch        { }
+
+no Moose::Role;
 no Moose::Util::TypeConstraints;
 
 =head1 BUGS
diff --git a/lib/Term/Filter/Callback.pm b/lib/Term/Filter/Callback.pm
new file mode 100644
index 0000000..4a32352
--- /dev/null
+++ b/lib/Term/Filter/Callback.pm
@@ -0,0 +1,56 @@
+package Term::Filter::Callback;
+use Moose;
+# ABSTRACT: Simple callback-based wrapper for L<Term::Filter>
+
+with 'Term::Filter';
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
+
+=attr callbacks
+
+=cut
+
+has callbacks => (
+    is      => 'ro',
+    isa     => 'HashRef[CodeRef]',
+    default => sub { {} },
+);
+
+sub _callback {
+    my $self = shift;
+    my ($event, @args) = @_;
+    my $callback = $self->callbacks->{$event};
+    return unless $callback;
+    return $self->$callback(@args);
+}
+
+sub _has_callback {
+    my $self = shift;
+    my ($event) = @_;
+    return exists $self->callbacks->{$event};
+}
+
+for my $method (qw(setup cleanup munge_input munge_output
+                   read read_error winch)) {
+    __PACKAGE__->meta->add_around_method_modifier(
+        $method => sub {
+            my $orig = shift;
+            my $self = shift;
+            if ($self->_has_callback($method)) {
+                return $self->_callback($method, @_);
+            }
+            else {
+                return $self->$orig(@_);
+            }
+        },
+    );
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
diff --git a/t/basic.t b/t/basic.t
index 0aeef5a..0df6495 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -10,8 +10,8 @@ my $pty = IO::Pty::Easy->new(handle_pty_size => 0);
 my $script = <<'SCRIPT';
 use strict;
 use warnings;
-use Term::Filter;
-my $term = Term::Filter->new;
+use Term::Filter::Callback;
+my $term = Term::Filter::Callback->new;
 $term->run($^X, '-ple', q[last if /^$/]);
 print "done\n";
 SCRIPT
diff --git a/t/callbacks.t b/t/callbacks.t
index 05ac5f7..5197b32 100644
--- a/t/callbacks.t
+++ b/t/callbacks.t
@@ -9,8 +9,8 @@ use IO::Select;
 my $script = <<'SCRIPT';
 use strict;
 use warnings;
-use Term::Filter;
-my $term = Term::Filter->new(
+use Term::Filter::Callback;
+my $term = Term::Filter::Callback->new(
     callbacks => {
         setup => sub {
             my ($t, @cmd) = @_;
@@ -63,7 +63,7 @@ alarm 60;
         $
     }sx;
 
-    is($ref, 'Term::Filter', "setup callback got a Term::Filter object");
+    is($ref, 'Term::Filter::Callback', "setup callback got a Term::Filter::Callback object");
 
     $pty->write("fOo\n");
 
diff --git a/t/extra-pty.t b/t/extra-pty.t
index 97a6408..d9d73da 100644
--- a/t/extra-pty.t
+++ b/t/extra-pty.t
@@ -20,12 +20,12 @@ POSIX::mkfifo($writep, 0700)
 my $script = <<SCRIPT;
 use strict;
 use warnings;
-use Term::Filter;
+use Term::Filter::Callback;
 open my \$readfh, '<', '$readp'
     or die "can't open pipe (child): \$!";
 open my \$writefh, '>', '$writep'
     or die "can't open pipe (child): \$!";
-my \$term = Term::Filter->new(
+my \$term = Term::Filter::Callback->new(
     callbacks => {
         setup => sub {
             my (\$t) = \@_;
diff --git a/t/requires-tty.t b/t/requires-tty.t
index e574f67..81895c2 100644
--- a/t/requires-tty.t
+++ b/t/requires-tty.t
@@ -4,18 +4,18 @@ use warnings;
 use Test::More;
 use Test::Fatal;
 
-use Term::Filter;
+use Term::Filter::Callback;
 
 my ($input, $output);
 open my $infh, '<', \$input or die "Couldn't open: $!";
 open my $outfh, '<', \$output or die "Couldn't open: $!";
 like(
-    exception { Term::Filter->new(input => $infh) },
+    exception { Term::Filter::Callback->new(input => $infh) },
     qr/Term::Filter requires input and output filehandles to be attached to a terminal/,
     "requires a terminal"
 );
 like(
-    exception { Term::Filter->new(output => $outfh) },
+    exception { Term::Filter::Callback->new(output => $outfh) },
     qr/Term::Filter requires input and output filehandles to be attached to a terminal/,
     "requires a terminal"
 );