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
|
#!/usr/bin/env perl
use strict;
use warnings;
use Cwd;
use Test::More;
use File::Temp qw(tempdir);
plan tests => 8;
use_ok 'Path::Class';
my $cwd = getcwd;
my $tmp = dir(tempdir(CLEANUP => 1));
# Test recursive iteration through the following structure:
# a
# / \
# b c
# / \ \
# d e f
# / \ \
# g h i
(my $abe = $tmp->subdir(qw(a b e)))->mkpath;
(my $acf = $tmp->subdir(qw(a c f)))->mkpath;
$acf->file('i')->touch;
$abe->file('h')->touch;
$abe->file('g')->touch;
$tmp->file(qw(a b d))->touch;
my $a = $tmp->subdir('a');
# Warmup without pruning
{
my %visited;
$a->recurse(
callback => sub{
my $item = shift;
my $rel_item = $item->relative($tmp);
my $tag = join '|', $rel_item->components;
$visited{$tag} = 1;
});
is_deeply(\%visited, {
"a" => 1, "a|b" => 1, "a|c" => 1,
"a|b|d" => 1, "a|b|e" => 1, "a|b|e|g" => 1, "a|b|e|h" => 1,
"a|c|f" => 1, "a|c|f|i" => 1, });
}
# Prune constant
ok( $a->PRUNE );
# Prune no 1
{
my %visited;
$a->recurse(
callback => sub{
my $item = shift;
my $rel_item = $item->relative($tmp);
my $tag = join '|', $rel_item->components;
$visited{$tag} = 1;
return $item->PRUNE if $tag eq 'a|b';
});
is_deeply(\%visited, {
"a" => 1, "a|b" => 1, "a|c" => 1,
"a|c|f" => 1, "a|c|f|i" => 1, });
}
# Prune constant alternative way
use_ok("Path::Class::Entity");
ok( Path::Class::Entity::PRUNE() );
is( $a->PRUNE, Path::Class::Entity::PRUNE() );
# Prune no 2
{
my %visited;
$a->recurse(
callback => sub{
my $item = shift;
my $rel_item = $item->relative($tmp);
my $tag = join '|', $rel_item->components;
$visited{$tag} = 1;
return Path::Class::Entity::PRUNE() if $tag eq 'a|c';
});
is_deeply(\%visited, {
"a" => 1, "a|b" => 1, "a|c" => 1,
"a|b|d" => 1, "a|b|e" => 1, "a|b|e|g" => 1, "a|b|e|h" => 1,
});
}
#diag("PRUNE constant value: " . $a->PRUNE);
|