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
112
113
|
use strict;
use warnings;
use Test::More 0.96;
my $mod = 'Config::MVP::Slicer';
eval "require $mod" or die $@;
my $config = {
'Plug.attr' => 'pa',
'Mod::Name.opt' => 'val',
'=Mod::Name.opt' => 'eq',
'Moose.and[]' => 'squirrel',
'@Bundle/Moose.and[]' => 'camel',
'@Bundle.opt' => 'red light',
'Hunting.season[0]' => 'duck',
'Hunting.season[1]' => 'wabbit',
'Hunting.season[9]' => 'fudd',
# keys are sorted very simply (alphabetically)
'Hunting2.season[1.09]' => 'bunny',
'Hunting2.season[1.10]' => 'bird',
'Hunting2.season[1.08]' => 'wabbit',
'Hunting2.season[1.11]' => 'duck',
'Hunting2.season[z]' => 'zombie',
};
sub rewrite_prefix {
local $_ = shift;
s/^=//
|| s/^@/BarX::/
|| s/^/FooX::/;
return $_;
}
# make sure the rewriter works
is rewrite_prefix('@Foo'), 'BarX::Foo', 'rewrite @';
is rewrite_prefix('=Foo'), 'Foo', 'rewrite =';
is rewrite_prefix( 'Foo'), 'FooX::Foo', 'rewrite everything else';
sub new_slicer {
new_ok($mod, [{
config => { opt => 'main config val', %$config },
match_name => sub { return 0 }, # no false positives
@_ ? (match_package => shift) : (),
}]);
}
my $slicer = new_slicer(); # default
# default match is $_[0] eq $_[1]
ok $slicer->match_package(qw(Foo Foo)), 'simple match';
ok !$slicer->match_package(qw(Foo FooX::Foo)), 'no match with namespace prefix';
ok !$slicer->match_package(qw(@Bar/Foo Foo)), 'no match with when @Bundle/ prefix is specified but not found';
ok !$slicer->match_package(qw(Foo F.+)), 'not a regexp';
my $rewriter = new_slicer(sub { rewrite_prefix($_[0]) eq $_[1] });
ok $rewriter->match_package(qw( Foo FooX::Foo)), 'match with rewritten namespace prefix';
ok $rewriter->match_package(qw(=Foo Foo)), 'match with rewritten empty prefix';
ok $rewriter->match_package(qw(@Foo BarX::Foo)), 'match with rewritten bundle prefix';
is_deeply
$slicer->slice([ModName => 'Mod::Name' => {}]),
{ opt => 'val' },
'default matches whole package name';
is_deeply
new_slicer(sub { return 0 })->slice([ModName => 'Mod::Name' => {}]),
{ },
'"always false" returns empty hash';
is_deeply
new_slicer(sub { return 1 })->slice([Plug => 'X::Plug' => {}]),
{
'attr' => 'pa',
'opt' => 'val',
'and' => [qw(camel squirrel)],
# keys are sorted alphabetically, so Hunting comes before Hunting2
season => [qw(duck wabbit fudd wabbit bunny bird duck zombie)],
},
'"always true" matches all items that match regexp';
is_deeply
$slicer->slice([Y => 'X::Moose' => {}]),
{ },
'nothing matched';
is_deeply
$rewriter->slice([U => 'FooX::Moose' => {}]),
{ and => ['squirrel'] },
'matched on default rewritten package';
is_deeply
$rewriter->slice([NO => 'BarX::Bundle' => {}]),
{ opt => 'red light' },
'matches on rewritten package for "@"';
is_deeply
$rewriter->slice([WORK => 'Mod::Name' => {}]),
{ opt => 'eq' },
'matches on rewritten package for "="';
is_deeply
$rewriter->slice([RIGHT => 'FooX::Mod::Name' => {}]),
{ opt => 'val' },
'matches on rewritten package for ""';
is_deeply
$rewriter->slice(['@Task/@Bundle/WhoMoose' => 'FooX::Moose' => {}]),
{ and => [qw(squirrel)] },
'matches package regardless of @Bundle/ prefixes on name (duh)';
done_testing;
|
