File Coverage

blib/lib/Term/Filter/Callback.pm
Criterion Covered Total %
statement 7 15 46.6
branch 0 2 0.0
condition n/a
subroutine 3 5 60.0
pod n/a
total 10 22 45.4


line stmt bran cond sub pod time code
1             package Term::Filter::Callback;
2             BEGIN {
3 1     1   45531 $Term::Filter::Callback::AUTHORITY = 'cpan:DOY';
4             }
5             {
6             $Term::Filter::Callback::VERSION = '0.03';
7             }
8 1     1   213172 use Moose;
  1         638406  
  1         8  
9             # ABSTRACT: Simple callback-based wrapper for L<Term::Filter>
10              
11             with 'Term::Filter';
12              
13              
14              
15             has callbacks => (
16             is => 'ro',
17             isa => 'HashRef[CodeRef]',
18             default => sub { {} },
19             );
20              
21             sub _callback {
22 0     0     my $self = shift;
23 0           my ($event, @args) = @_;
24 0           my $callback = $self->callbacks->{$event};
25 0 0         return unless $callback;
26 0           return $self->$callback(@args);
27             }
28              
29             sub _has_callback {
30 0     0     my $self = shift;
31 0           my ($event) = @_;
32 0           return exists $self->callbacks->{$event};
33             }
34              
35             for my $method (qw(setup cleanup munge_input munge_output
36             read read_error winch)) {
37             __PACKAGE__->meta->add_around_method_modifier(
38             $method => sub {
39             my $orig = shift;
40             my $self = shift;
41             if ($self->_has_callback($method)) {
42             return $self->_callback($method, @_);
43             }
44             else {
45             return $self->$orig(@_);
46             }
47             },
48             );
49             }
50              
51             __PACKAGE__->meta->make_immutable;
52 1     1   8162 no Moose;
  1         2  
  1         5  
53              
54             1;
55              
56             __END__
57             =pod
58              
59             =head1 NAME
60              
61             Term::Filter::Callback - Simple callback-based wrapper for L<Term::Filter>
62              
63             =head1 VERSION
64              
65             version 0.03
66              
67             =head1 SYNOPSIS
68              
69             use Term::Filter::Callback;
70              
71             my $term = Term::Filter::Callback->new(
72             callbacks => {
73             munge_input => sub {
74             my $self = shift;
75             my ($got) = @_;
76             $got =~ s/\ce/E- Elbereth\n/g;
77             $got;
78             },
79             munge_output => sub {
80             my $self = shift;
81             my ($got) = @_;
82             $got =~ s/(Elbereth)/\e[35m$1\e[m/g;
83             $got;
84             },
85             },
86             );
87              
88             $term->run('nethack');
89              
90             =head1 DESCRIPTION
91              
92             This module provides a callback-based API to L<Term::Filter>. The desired
93             callbacks can just be passed into the constructor of this class, rather than
94             requiring a new class to be manually defined. This class consumes the
95             L<Term::Filter> role, so the rest of the documentation in that module applies
96             here.
97              
98             =head1 ATTRIBUTES
99              
100             =head2 callbacks
101              
102             A hashref of callbacks for L<Term::Filter>. The keys are
103             L<callback names|Term::Filter/CALLBACKS> and the values are coderefs to call
104             for those callbacks.
105              
106             =head1 AUTHOR
107              
108             Jesse Luehrs <doy at tozt dot net>
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             This software is copyright (c) 2012 by Jesse Luehrs.
113              
114             This is free software; you can redistribute it and/or modify it under
115             the same terms as the Perl 5 programming language system itself.
116              
117             =cut
118