line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Tree::Simple::Visitor::LoadDirectoryTree; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
26298
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.14'; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
use File::Spec; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
9
|
1
|
|
|
1
|
|
5
|
use Scalar::Util qw(blessed); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
156
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
6
|
use base qw(Tree::Simple::Visitor); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
706
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub new { |
14
|
4
|
|
|
4
|
1
|
6733
|
my ($_class) = @_; |
15
|
4
|
|
33
|
|
|
34
|
my $class = ref($_class) || $_class; |
16
|
4
|
|
|
|
|
10
|
my $visitor = {}; |
17
|
4
|
|
|
|
|
12
|
bless($visitor, $class); |
18
|
4
|
|
|
|
|
17
|
$visitor->_init(); |
19
|
4
|
|
|
|
|
36
|
return $visitor; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub _init { |
23
|
4
|
|
|
4
|
|
8
|
my ($self) = @_; |
24
|
4
|
|
|
|
|
17
|
$self->{sort_function} = undef; |
25
|
4
|
|
|
|
|
23
|
$self->SUPER::_init(); |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# pre-built sort functions |
29
|
|
|
|
|
|
|
sub SORT_FILES_FIRST { |
30
|
|
|
|
|
|
|
return sub ($$$) { |
31
|
165
|
|
|
165
|
|
219
|
my ($path, $left, $right) = @_; |
32
|
165
|
|
|
|
|
788
|
$left = File::Spec->catdir($path, $left); |
33
|
165
|
|
|
|
|
652
|
$right = File::Spec->catdir($path, $right); |
34
|
165
|
100
|
100
|
|
|
3349
|
return ((-d $left && -f $right) ? 1 : # file beats directory |
|
|
100
|
100
|
|
|
|
|
35
|
|
|
|
|
|
|
(-d $right && -f $left) ? -1 : # file beats directory |
36
|
|
|
|
|
|
|
(lc($left) cmp lc($right))) # otherwise just sort 'em |
37
|
|
|
|
|
|
|
} |
38
|
1
|
|
|
1
|
1
|
1614
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub SORT_DIRS_FIRST { |
41
|
|
|
|
|
|
|
return sub ($$$) { |
42
|
163
|
|
|
163
|
|
211
|
my ($path, $left, $right) = @_; |
43
|
163
|
|
|
|
|
658
|
$left = File::Spec->catdir($path, $left); |
44
|
163
|
|
|
|
|
589
|
$right = File::Spec->catdir($path, $right); |
45
|
163
|
100
|
100
|
|
|
3150
|
return ((-d $left && -f $right) ? -1 : # directory beats file |
|
|
100
|
100
|
|
|
|
|
46
|
|
|
|
|
|
|
(-d $right && -f $left) ? 1 : # directory beats file |
47
|
|
|
|
|
|
|
(lc($left) cmp lc($right))) # otherwise just sort 'em |
48
|
|
|
|
|
|
|
} |
49
|
1
|
|
|
1
|
1
|
1498
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub setSortStyle { |
52
|
5
|
|
|
5
|
1
|
2480
|
my ($self, $sort_function) = @_; |
53
|
5
|
100
|
100
|
|
|
77
|
(defined($sort_function) && ref($sort_function) eq "CODE") |
54
|
|
|
|
|
|
|
|| die "Insufficient Arguments : sort function argument must be a subroutine reference"; |
55
|
2
|
|
|
|
|
7
|
$self->{sort_function} = $sort_function; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub visit { |
59
|
9
|
|
|
9
|
1
|
4226
|
my ($self, $tree) = @_; |
60
|
9
|
100
|
100
|
|
|
181
|
(blessed($tree) && $tree->isa("Tree::Simple")) |
61
|
|
|
|
|
|
|
|| die "Insufficient Arguments : You must supply a valid Tree::Simple object"; |
62
|
|
|
|
|
|
|
# it must be a leaf |
63
|
5
|
100
|
|
|
|
27
|
($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a directory"; |
64
|
|
|
|
|
|
|
# check that our directory is valid |
65
|
4
|
|
|
|
|
62
|
my $root_dir = $tree->getNodeValue(); |
66
|
4
|
100
|
66
|
|
|
209
|
(-e $root_dir && -d $root_dir) |
67
|
|
|
|
|
|
|
|| die "Incorrect Type : The tree's node value must be a valid directory"; |
68
|
|
|
|
|
|
|
# and load it recursively |
69
|
3
|
|
|
|
|
16
|
$self->_recursiveLoad($tree, $root_dir); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub _recursiveLoad { |
73
|
18
|
|
|
18
|
|
30
|
my ($self, $t, $path) = @_; |
74
|
|
|
|
|
|
|
# get a node filter if we have one |
75
|
18
|
|
|
|
|
59
|
my $filter = $self->getNodeFilter(); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# get the contents of the directory |
78
|
18
|
50
|
|
|
|
526
|
opendir(DIR, $path) || die "IO Error : Could not open directory : $!"; |
79
|
|
|
|
|
|
|
# avoid the . and .. symbolic links |
80
|
|
|
|
|
|
|
my @dir_contents = grep { |
81
|
18
|
100
|
|
|
|
309
|
$_ ne File::Spec->curdir() && $_ ne File::Spec->updir() |
|
207
|
|
|
|
|
1085
|
|
82
|
|
|
|
|
|
|
} readdir(DIR); |
83
|
18
|
|
|
|
|
43
|
close(DIR); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# sort them if we need to with full paths |
86
|
|
|
|
|
|
|
@dir_contents = sort { |
87
|
328
|
|
|
|
|
553
|
$self->{sort_function}->($path, $a, $b) |
88
|
18
|
100
|
|
|
|
84
|
} @dir_contents if $self->{sort_function}; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# now traverse ... |
91
|
18
|
|
|
|
|
41
|
foreach my $item (@dir_contents) { |
92
|
|
|
|
|
|
|
# filter based on the item name |
93
|
171
|
50
|
100
|
|
|
12862
|
$filter->($item) || next if defined($filter); |
94
|
|
|
|
|
|
|
# get the full path for checking |
95
|
|
|
|
|
|
|
# the item type and recursion |
96
|
141
|
|
|
|
|
1977
|
my $full_path = File::Spec->catdir($path, $item); |
97
|
141
|
100
|
|
|
|
2720
|
if (-d $full_path) { |
|
|
50
|
|
|
|
|
|
98
|
15
|
|
|
|
|
84
|
my $new_tree = $t->new($item); |
99
|
15
|
|
|
|
|
530
|
$t->addChild($new_tree); |
100
|
15
|
|
|
|
|
1208
|
$self->_recursiveLoad($new_tree, $full_path); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif (-f $full_path) { |
103
|
126
|
|
|
|
|
329
|
$t->addChild($t->new($item)); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
1; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
__END__ |