File Coverage

blib/lib/Devel/Events/Filter/Drop.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Devel::Events::Filter::Drop;
4 2     2   26692 use Moose;
  0            
  0            
5              
6             with qw/Devel::Events::Filter/;
7              
8             use Devel::Events::Match;
9              
10             has non_matching => (
11             isa => "Bool",
12             is => "rw",
13             default => 0,
14             );
15              
16             has matcher => (
17             isa => "Devel::Events::Match",
18             is => "ro",
19             default => sub { Devel::Events::Match->new },
20             );
21              
22             has match => (
23             isa => "Any",
24             is => "ro",
25             required => 1,
26             );
27              
28             has _compiled_match => (
29             isa => "CodeRef",
30             is => "ro",
31             lazy => 1,
32             default => sub {
33             my $self = shift;
34             $self->_compile_match;
35             },
36             );
37              
38             sub _compile_match {
39             my $self = shift;
40             $self->matcher->compile_cond( $self->match );
41             }
42              
43             sub filter_event {
44             my ( $self, @event ) = @_;
45              
46             my $event_matches = $self->_compiled_match->(@event);
47              
48             if ( $event_matches xor !$self->non_matching ) {
49             return @event;
50             } else {
51             return;
52             }
53             }
54              
55              
56             __PACKAGE__;
57              
58             __END__
59              
60             =pod
61              
62             =head1 NAME
63              
64             Devel::Events::Filter::Drop - Remove events that match or don't match a
65             condition.
66              
67             =head1 SYNOPSIS
68              
69             use Devel::Events::Filter::Drop;
70              
71             my $f = Devel::Events::Filter::Drop->new(
72             match => $cond, # see Devel::Events::Match
73             non_matching => 1, # invert so that nonmatching events get dropped
74             handler => $h,
75             );
76              
77             =head1 DESCRIPTION
78              
79             This filter allows dropping of events that match (or that don't match) a
80             condition. The actual matching is done by L<Devel::Events::Match>.
81              
82             =head1 ATTRIBUTES
83              
84             =over 4
85              
86             =item match
87              
88             The condition to be passed to L<Devel::Events::Match/compile_cond>.
89              
90             =item matcher
91              
92             An instance of L<Devel::Events::Match> used to compile C<match>.
93              
94             =item non_matching
95              
96             Drop events that don't match the condition, instead of ones that do.
97              
98             =back
99              
100             =head1 METHODS
101              
102             =over 4
103              
104             =item filter_event @event
105              
106             Delegates to the compiled condition and then returns the event unaltered or
107             returns nothing based on the values of C<non_matching> and the result of the
108             match.
109              
110             =back
111              
112             =cut
113