1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#============================================================= -*-perl-*-
#
# t/misc/filter.t
#
# Test the Badger::Filter module.
#
# Copyright (C) 2013 Andy Wardley. All Rights Reserved.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib ../../lib );
use Badger::Debug ':all';
use Badger::Test
tests => 7,
debug => 'Badger::Filter',
args => \@ARGV;
# behold the Ron Swanson picnic filter!
use Badger::Filter 'Filter';
my $pkg = 'Badger::Filter';
my $flt1 = $pkg->new(
include => [
qw(meat cheese ham eggs),
qr/beer|wine/,
sub { $_[0] eq 'soda' },
],
exclude => [
'root beer',
qr/alcohol-free|salad|diet/,
sub {
shift =~ /ferret/;
}
]
);
ok( $flt1, 'created first filter' );
my @things = (
qw( meat neat cheese peas ham eggs beer wine soda stoat monkey ferret ),
'root beer',
'alcohol-free beer',
'alcohol-free wine',
'diet soda',
'green salad',
'green eggs',
'diet salad',
'diet meat',
'more beer',
);
my @in = $flt1->accept(@things);
my $in = join(', ', @in);
is(
$in,
'meat, cheese, ham, eggs, beer, wine, soda, more beer',
'matched in items'
);
my @out = $flt1->reject(@things);
my $out = join(', ', @out);
is(
$out,
'neat, peas, stoat, monkey, ferret, root beer, alcohol-free beer, alcohol-free wine, diet soda, green salad, green eggs, diet salad, diet meat',
'matched out items'
);
#-----------------------------------------------------------------------------
# Test Filter() sub
#-----------------------------------------------------------------------------
my $flt2 = Filter( include => qr/beer/ );
my $suds = join(', ', $flt2->accept(@things));
is(
$suds,
'beer, root beer, alcohol-free beer, more beer',
'matched beer items'
);
#-----------------------------------------------------------------------------
# Test simple accept option
#-----------------------------------------------------------------------------
my $all = Filter( accept => 'all' );
is (
join(', ', $all->accept(qw( a b c d ))),
'a, b, c, d',
'accept all',
);
my $none = Filter( accept => 'none' );
is (
join(', ', $none->accept(qw( a b c d ))),
'',
'accept none',
);
my $star = Filter( include => 'foo*' );
is (
join(', ', $star->accept(qw( foo food foodstuff notfood bar barbell ))),
'foo, food, foodstuff',
'accept star wildcard',
);
|
