File Coverage

blib/lib/App/Rakubrew/Tools.pm
Criterion Covered Total %
statement 39 44 88.6
branch 5 8 62.5
condition 1 2 50.0
subroutine 10 13 76.9
pod 0 7 0.0
total 55 74 74.3


line stmt bran cond sub pod time code
1             package App::Rakubrew::Tools;
2             require Exporter;
3             our @ISA = qw( Exporter );
4             our @EXPORT = qw(run slurp spurt trim uniq slurp_dir my_fileparse);
5              
6 15     15   89 use strict;
  15         27  
  15         572  
7 15     15   70 use warnings;
  15         43  
  15         743  
8 15     15   269 use 5.010;
  15         50  
9 15     15   69 use File::Spec::Functions qw(catfile);
  15         50  
  15         911  
10 15     15   76 use File::Basename;
  15         30  
  15         1048  
11 15     15   89 use Carp qw(croak);
  15         35  
  15         8328  
12              
13             sub run {
14 0 0   0 0 0 system(@_) and croak "Failed running ".$_[0]
15             }
16              
17             sub slurp {
18 19     19 0 41 my $file = shift;
19 19         600 open(my $fh, '<', $file);
20 19         110 local $/ = '';
21 19         475 my $ret = <$fh>;
22 19         178 close($fh);
23 19   50     170 return $ret // '';
24             }
25              
26             sub spurt {
27 5     5 0 19 my ($file, $cont) = @_;
28 5         994 open(my $fh, '>', $file);
29 5         117 say $fh $cont;
30 5         186 close($fh);
31             }
32              
33             sub trim {
34 12     12 0 23 my $text = shift;
35 12         85 $text =~ s/^\s+|\s+$//g;
36 12         43 return $text;
37             }
38              
39             sub uniq {
40 0     0 0 0 my %seen;
41 0         0 return grep { !$seen{$_}++ } @_;
  0         0  
42             }
43              
44             sub slurp_dir {
45 2     2 0 3 my $name = shift;
46 2 100       69 opendir(my $dh, $name) or return;
47 1         2 my @ret;
48 1         15 while (my $entry = readdir $dh) {
49 4 100       10 next if $entry =~ /^\./;
50 2 50       22 next if !-f catfile($name, $entry);
51 2         11 push @ret, $entry;
52             }
53 1         7 closedir $dh;
54 1         6 return @ret;
55             }
56              
57             sub my_fileparse {
58 0     0 0   return fileparse(shift, ('.dll.lib', qr/\.[^.]+/));
59             }
60              
61             1;
62