| 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; |