From 0f6d95e7959d2978a869b373649fc5e49f733159 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Mon, 5 Mar 2012 22:56:18 -0600 Subject: factor out the callback stuff, make Term::Filter a role --- lib/Term/Filter.pm | 53 ++++++++++++++---------------------------- lib/Term/Filter/Callback.pm | 56 +++++++++++++++++++++++++++++++++++++++++++++ t/basic.t | 4 ++-- t/callbacks.t | 6 ++--- t/extra-pty.t | 4 ++-- t/requires-tty.t | 6 ++--- 6 files changed, 83 insertions(+), 46 deletions(-) create mode 100644 lib/Term/Filter/Callback.pm 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 + +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 = <', '$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" ); -- cgit v1.2.3-54-g00ecf