File Coverage

blib/lib/Minilla/Util.pm
Criterion Covered Total %
statement 33 114 28.9
branch 0 32 0.0
condition 0 5 0.0
subroutine 11 27 40.7
pod 0 16 0.0
total 44 194 22.6


line stmt bran cond sub pod time code
1             package Minilla::Util;
2 61     61   408 use strict;
  61         105  
  61         1806  
3 61     61   275 use warnings;
  61         105  
  61         1671  
4 61     61   349 use utf8;
  61         125  
  61         347  
5 61     61   1457 use Carp ();
  61         114  
  61         1269  
6 61     61   363 use File::Basename ();
  61         148  
  61         1016  
7 61     61   288 use File::Spec ();
  61         145  
  61         1466  
8 61     61   1213 use File::Which 'which';
  61         2281  
  61         3450  
9 61     61   777 use Minilla::Logger ();
  61         123  
  61         1196  
10 61     61   46127 use Getopt::Long ();
  61         630092  
  61         1789  
11 61     61   456 use Cwd();
  61         112  
  61         1251  
12              
13 61     61   291 use parent qw(Exporter);
  61         112  
  61         433  
14              
15             our @EXPORT_OK = qw(
16             find_dir find_file
17             randstr
18             slurp slurp_utf8 slurp_raw
19             spew spew_utf8 spew_raw
20             edit_file require_optional
21             cmd cmd_perl
22             pod_escape
23             parse_options
24             check_git
25             );
26              
27             our %EXPORT_TAGS = (
28             all => \@EXPORT_OK
29             );
30              
31             sub randstr {
32 0     0 0   my $len = shift;
33 0           my @chars = ("a".."z","A".."Z",0..9);
34 0           my $ret = '';
35 0           join('', map { $chars[int(rand(scalar(@chars)))] } 1..$len);
  0            
36             }
37              
38             sub slurp {
39 0     0 0   my $fname = shift;
40 0 0         open my $fh, '<', $fname
41             or Carp::croak("Can't open '$fname' for reading: '$!'");
42 0           scalar do { local $/; <$fh> }
  0            
  0            
43             }
44              
45             sub slurp_utf8 {
46 0     0 0   my $fname = shift;
47 0 0         open my $fh, '<:encoding(UTF-8)', $fname
48             or Carp::croak("Can't open '$fname' for reading: '$!'");
49 0           scalar do { local $/; <$fh> }
  0            
  0            
50             }
51              
52             sub slurp_raw {
53 0     0 0   my $fname = shift;
54 0 0         open my $fh, '<:raw', $fname
55             or Carp::croak("Can't open '$fname' for reading: '$!'");
56 0           scalar do { local $/; <$fh> }
  0            
  0            
57             }
58              
59             sub spew($$) {
60 0     0 0   my $fname = shift;
61 0 0         open my $fh, '>', $fname
62             or Carp::croak("Can't open '$fname' for writing: '$!'");
63 0           print {$fh} $_[0];
  0            
64             }
65              
66             sub spew_raw {
67 0     0 0   my $fname = shift;
68 0 0         open my $fh, '>:raw', $fname
69             or Carp::croak("Can't open '$fname' for writing: '$!'");
70 0           print {$fh} $_[0];
  0            
71             }
72              
73             sub spew_utf8 {
74 0     0 0   my $fname = shift;
75 0 0         open my $fh, '>:encoding(UTF8)', $fname
76             or Carp::croak("Can't open '$fname' for writing: '$!'");
77 0           print {$fh} $_[0];
  0            
78             }
79              
80             sub edit_file {
81 0     0 0   my ($file) = @_;
82 0   0       my $editor = $ENV{"EDITOR"} || "vi";
83 0           system( $editor, $file );
84             }
85              
86             sub find_file {
87 0     0 0   my ($file) = @_;
88              
89 0           my $dir = Cwd::getcwd();
90 0           my %seen;
91 0           while ( -d $dir ) {
92 0 0         return undef if $seen{$dir}++; # guard from deep recursion
93 0 0         if ( -f "$dir/$file" ) {
94 0           return "$dir/$file";
95             }
96 0           $dir = File::Basename::dirname($dir);
97             }
98              
99 0           return undef;
100             }
101              
102             sub find_dir {
103 0     0 0   my ($file) = @_;
104              
105 0           my $dir = Cwd::getcwd();
106 0           my %seen;
107 0           while ( -d $dir ) {
108 0 0         return undef if $seen{$dir}++; # guard from deep recursion
109 0 0         if ( -d "$dir/$file" ) {
110 0           return "$dir/$file";
111             }
112 0           $dir = File::Basename::dirname($dir);
113             }
114              
115 0           return undef;
116             }
117              
118             sub require_optional {
119 0     0 0   my ( $file, $feature, $library ) = @_;
120              
121 0 0         return if exists $INC{$file};
122 0 0         unless ( eval { require $file } ) {
  0            
123 0 0         if ( $@ =~ /^Can't locate/ ) {
124 0   0       $library ||= do {
125 0           local $_ = $file;
126 0           s/ \.pm \z//xms;
127 0           s{/}{::}g;
128 0           $_;
129             };
130 0           Carp::croak( "$feature requires $library, but it is not available."
131             . " Please install $library using your preferred CPAN client" );
132             }
133             else {
134 0           die $@;
135             }
136             }
137             }
138              
139             sub cmd_perl {
140 0     0 0   my(@args) = @_;
141              
142 0 0         my @abs_inc = map { $_ eq '.' ? $_ : File::Spec->rel2abs($_) }
  0            
143             @INC;
144              
145 0           cmd($^X, (map { "-I$_" } @abs_inc), @args);
  0            
146             }
147              
148             sub cmd {
149 0     0 0   Minilla::Logger::infof("[%s] \$ %s\n", File::Basename::basename(Cwd::getcwd()), "@_");
150 0 0         system(@_) == 0
151             or Minilla::Logger::errorf("Giving up.\n");
152             }
153              
154             sub parse_options {
155 0     0 0   my ( $args, @spec ) = @_;
156 0           Getopt::Long::GetOptionsFromArray( $args, @spec );
157             }
158              
159             sub pod_escape {
160 0     0 0   local $_ = shift;
161 0           my %POD_ESCAPE = ( '<' => 'E', '>' => 'E' );
162 0           s!([<>])!$POD_ESCAPE{$1}!ge;
  0            
163 0           $_;
164             }
165              
166             sub check_git {
167 0 0   0 0   unless (which 'git') {
168 0           Minilla::Logger::errorf("The \"git\" executable has not been found.\n");
169             }
170             }
171              
172             1;
173