File Coverage

lib/App/Perlbrew/Util.pm
Criterion Covered Total %
statement 45 46 97.8
branch 12 14 85.7
condition 6 8 75.0
subroutine 9 9 100.0
pod 0 5 0.0
total 72 82 87.8


line stmt bran cond sub pod time code
1             package App::Perlbrew::Util;
2 60     60   110440 use strict;
  60         127  
  60         1998  
3 60     60   274 use warnings;
  60         109  
  60         1327  
4 60     60   826 use 5.008;
  60         173  
5              
6 60     60   276 use Exporter 'import';
  60         108  
  60         31733  
7             our @EXPORT = qw(uniq min editdist files_are_the_same perl_version_to_integer);
8              
9             sub uniq {
10 31     31 0 38 my %seen;
11 31         71 grep { !$seen{$_}++ } @_;
  0         0  
12             }
13              
14             sub min(@) {
15 6820     6820 0 6779 my $m = $_[0];
16 6820         7691 for(@_) {
17 20460 100       28187 $m = $_ if $_ < $m;
18             }
19 6820         9034 return $m;
20             }
21              
22             # straight copy of Wikipedia's "Levenshtein Distance"
23             sub editdist {
24 46     46 0 188 my @a = split //, shift;
25 46         106 my @b = split //, shift;
26              
27             # There is an extra row and column in the matrix. This is the
28             # distance from the empty string to a substring of the target.
29 46         54 my @d;
30 46         250 $d[$_][0] = $_ for (0 .. @a);
31 46         216 $d[0][$_] = $_ for (0 .. @b);
32              
33 46         61 for my $i (1 .. @a) {
34 503         694 for my $j (1 .. @b) {
35 7106 100       12245 $d[$i][$j] = ($a[$i-1] eq $b[$j-1] ? $d[$i-1][$j-1]
36             : 1 + min($d[$i-1][$j], $d[$i][$j-1], $d[$i-1][$j-1]));
37             }
38             }
39              
40 46         267 return $d[@a][@b];
41             }
42              
43             sub files_are_the_same {
44             ## Check dev and inode num. Not useful on Win32.
45             ## The for loop should always return false on Win32, as a result.
46              
47 25     25 0 4982 my @files = @_;
48 25         49 my @stats = map {[ stat($_) ]} @files;
  50         603  
49              
50 25         48 my $stats0 = join " ", @{$stats[0]}[0,1];
  25         69  
51 25         45 for (@stats) {
52 50 100 66     146 return 0 if ((! defined($_->[1])) || $_->[1] == 0);
53 49 100       146 unless ($stats0 eq join(" ", $_->[0], $_->[1])) {
54 14         50 return 0;
55             }
56             }
57 10         32 return 1
58             }
59              
60             sub perl_version_to_integer {
61 104     104 0 2723 my $version = shift;
62 104         224 my @v = split(/[\.\-_]/, $version);
63 104 50       164 return undef if @v < 2;
64 104 100       152 if ($v[1] <= 5) {
65 12   100     47 $v[2] ||= 0;
66 12         15 $v[3] = 0;
67             }
68             else {
69 92 50 66     233 $v[3] ||= $v[1] >= 6 ? 9 : 0;
70 92         131 $v[3] =~ s/[^0-9]//g;
71             }
72              
73 104         219 return $v[1]*1000000 + $v[2]*1000 + $v[3];
74             }
75              
76             1;