File Coverage

blib/lib/File/Common.pm
Criterion Covered Total %
statement 59 59 100.0
branch 19 22 86.3
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 87 90 96.6


line stmt bran cond sub pod time code
1             package File::Common;
2              
3             our $DATE = '2019-04-16'; # DATE
4             our $VERSION = '0.003'; # VERSION
5              
6 1     1   56940 use 5.010001;
  1         11  
7 1     1   4 use strict;
  1         1  
  1         33  
8 1     1   5 use warnings;
  1         1  
  1         24  
9              
10 1     1   399 use File::chdir;
  1         2622  
  1         113  
11 1     1   6 use File::Find;
  1         1  
  1         58  
12              
13 1     1   5 use Exporter qw(import);
  1         1  
  1         440  
14             our @EXPORT_OK = qw(list_common_files);
15              
16             our %SPEC;
17              
18             $SPEC{list_common_files} = {
19             v => 1.1,
20             summary => 'List files that are found in {all,more than one} directories',
21             description => <<'_',
22              
23             This routine lists files that are found in all specified directories (or, when
24             `min_occurrences` option is specified, files that are found in at least a
25             certain number of occurrences. Note that only filenames are compared, not
26             content/checksum. Directories are excluded.
27              
28             _
29             args => {
30             dirs => {
31             'x.name.is_plural' => 1,
32             'x.name.singular' => 'dir',
33             schema => ['array*', of=>'dirname*', min_len=>2],
34             req => 1,
35             pos => 0,
36             slurpy => 1,
37             },
38             min_occurrence => {
39             schema => 'posint*',
40             },
41             detail => {
42             summary => 'Whether to return detailed result per file',
43             schema => 'bool*',
44             description => <<'_',
45              
46             If set to true, instead of an array of filenames:
47              
48             ["file1", "file2"]
49              
50             it will instead return a hash with filename as key and another hash containing
51             detailed information:
52              
53             {
54             "file1" => {
55             dirs => ["dir1", "dir2"], # in which dirs the file is found
56             },
57             "file2" => {
58             ...
59             },
60             }
61              
62              
63             _
64             }
65             },
66             result_naked => 1,
67             };
68             sub list_common_files {
69 4     4 1 10828 my %args = @_;
70              
71 4 50       13 my $dirs = $args{dirs} or die "Please specify 'dirs'";
72 4 50       10 @$dirs >= 2 or die "Please specify at least 2 directories";
73 4         5 my $min_occurrence = $args{min_occurrence};
74 4         6 my $detail = $args{detail};
75              
76 4         6 my @all_files; # index = dir index, elem = hash of path=>1
77 4         5 for my $i (0..$#{$dirs}) {
  4         10  
78 12         164 my $dir = $dirs->[$i];
79 12 50       125 (-d $dir) or die "No such directory: $dir";
80 12         47 local $CWD = $dir;
81 12         385 my %files;
82             find(
83             sub {
84 132 100   132   2603 return unless -f;
85 100         224 my $path = "$File::Find::dir/$_";
86 100         312 $path =~ s!\A\./!!;
87 100         1070 $files{$path} = 1;
88             },
89 12         477 ".",
90             );
91 12         97 push @all_files, \%files;
92             }
93              
94 4         78 my %res;
95 4 100       13 if (defined $min_occurrence) {
96 2         6 for my $i (0..$#all_files) {
97 6         8 for my $f (keys %{ $all_files[$i] }) {
  6         19  
98 50 100       62 if ($detail) {
99 25         22 push @{ $res{$f}{dirs} }, $dirs->[$i];
  25         62  
100             } else {
101 25         34 $res{$f}++;
102             }
103             }
104             }
105 2 100       5 if ($detail) {
106 1         4 for my $k (keys %res) {
107 16 100       16 delete $res{$k} unless @{ $res{$k}{dirs} } >= $min_occurrence;
  16         30  
108             }
109 1         23 return \%res;
110             } else {
111 1         4 return [sort grep { $res{$_} >= $min_occurrence } keys %res];
  16         37  
112             }
113             } else {
114             FILE:
115 2         3 for my $f0 (keys %{ $all_files[0] }) {
  2         10  
116 16         20 for my $i (1..$#all_files) {
117 26 100       44 next FILE unless $all_files[$i]{$f0};
118             }
119 4 100       7 if ($detail) {
120 2         5 $res{$f0}{dirs} = $dirs;
121             } else {
122 2         4 $res{$f0}++;
123             }
124             }
125 2 100       28 return $detail ? \%res : [sort keys %res];
126             }
127             }
128              
129             1;
130             # ABSTRACT: List files that are found in {all,more than one} directories
131              
132             __END__