File Coverage

blib/lib/App/ArduinoBuilder/FilePath.pm
Criterion Covered Total %
statement 38 66 57.5
branch 7 22 31.8
condition 2 11 18.1
subroutine 11 14 78.5
pod 0 3 0.0
total 58 116 50.0


line stmt bran cond sub pod time code
1             package App::ArduinoBuilder::FilePath;
2              
3 1     1   229354 use strict;
  1         9  
  1         28  
4 1     1   5 use warnings;
  1         2  
  1         21  
5 1     1   5 use utf8;
  1         2  
  1         5  
6              
7 1     1   483 use App::ArduinoBuilder::Logger;
  1         3  
  1         73  
8 1     1   9 use Exporter 'import';
  1         2  
  1         23  
9 1     1   11 use File::Find;
  1         2  
  1         104  
10 1     1   511 use File::Spec::Functions 'catdir', 'rel2abs';
  1         964  
  1         69  
11 1     1   7 use List::Util 'min', 'any';
  1         2  
  1         926  
12              
13             our @EXPORT_OK = qw(find_latest_revision_dir list_sub_directories find_all_files_with_extensions);
14              
15             sub _compare_version_string {
16 87     87   398 my @la = split /\.|-/, $a;
17 87         279 my @lb = split /\.|-/, $b;
18 87         302 for my $i (0..min($#la, $#lb)) {
19             # Let’s try to handle things like: 1.5.0-b
20 174   66     517 my $c = $la[$i] <=> $lb[$i] || $la[$i] cmp $lb[$i];
21 174 100       497 return $c if $c;
22             }
23 31         125 return $#la <=> $#lb;
24             }
25              
26             sub _pick_highest_version_string {
27 41     41   3569 return (sort _compare_version_string @_)[-1];
28             }
29              
30             # find_latest_revision('/path/to/dir') --> '/path/to/dir/9.8.2'
31             # Returns the input if there are no sub-directories looking like revisions in
32             # the given directory.
33             sub find_latest_revision_dir {
34 2     2 0 391 my ($dir) = @_;
35 2 50       110 opendir my $dh, $dir or fatal "Can’t open dir '$dir': $!";
36 2 100       66 my @revs_dir = grep { -d catdir($dir, $_) && m/^\d+(?:\.\d+)?(?:-.*)?/ } readdir($dh);
  9         236  
37 2         27 closedir $dh;
38 2 100       18 return $dir unless @revs_dir;
39 1         3 return catdir($dir, _pick_highest_version_string(@revs_dir));
40             }
41              
42             sub list_sub_directories {
43 0     0 0   my ($dir) = @_;
44 0 0         opendir my $dh, $dir or fatal "Can’t open dir '$dir': $!";
45 0 0         my @sub_dirs = grep { -d catdir($dir, $_) && ! m/^\./ } readdir($dh);
  0            
46 0           closedir $dh;
47 0           return @sub_dirs;
48             }
49              
50             # $dir can be a single directory to search or an array ref.
51             # excluded_dirs must be an array_ref
52             sub find_all_files_with_extensions {
53 0     0 0   my ($dir, $exts, $excluded_dirs, $no_recurse) = @_;
54 0           my $exts_re = join('|', @{$exts});
  0            
55 0   0       my @excluded_dirs = map { rel2abs($_) } @{$excluded_dirs // []};
  0            
  0            
56 0           my @found;
57 0 0         my @dirs = ref $dir ? @{$dir} : $dir;
  0            
58 0           for my $d (@dirs) {
59 0           my $is_root = 1;
60 0 0 0 0     find(sub { push @found, $File::Find::name if -f && m/\.(?:$exts_re)$/;
61 0 0         if (-d) {
62 0 0 0       if ($no_recurse && !$is_root) {
63 0           $File::Find::prune = 1;
64 0           return;
65             }
66 0           my $a = rel2abs($_);
67 0 0         $File::Find::prune = any { $_ eq $a || /^\./ } @excluded_dirs;
  0            
68 0           $is_root = 0;
69             }
70 0           }, $d);
71             }
72 0           return @found;
73             }
74              
75             1;