File Coverage

blib/lib/CLI/Driver/CommonRole.pm
Criterion Covered Total %
statement 145 294 49.3
branch 12 180 6.6
condition 2 39 5.1
subroutine 44 55 80.0
pod n/a
total 203 568 35.7


line stmt bran cond sub pod time code
1             package CLI::Driver::CommonRole;
2              
3 18     18   11433 use Modern::Perl;
  18         39  
  18         164  
4 18     18   10920 use Moose::Role;
  18         89019  
  18         73  
5 18     18   92106 use namespace::autoclean;
  18         42  
  18         168  
6 18     18   1476 use Kavorka 'method';
  18         48  
  18         153  
7 18     18   11116 use Data::Printer alias => 'pdump';
  18         41  
  18         193  
8 18     18   14067 use Devel::Confess;
  18         141792  
  18         82  
9 18     18   11167 use Capture::Tiny 'capture';
  18         357572  
  18         1292  
10 18     18   8252 use Time::localtime;
  18         90885  
  18         1202  
11              
12             #########################################################################################
13              
14             has verbosity => (
15             is => 'rw',
16             isa => 'Num',
17             lazy => 1,
18             builder => '_build_verbosity',
19             );
20              
21             #########################################################################################
22              
23 18 0   18   46138 method chdir (Str $dir) {
  18 0   18   48  
  18 0   0   2923  
  18 0       127  
  18 0       46  
  18         2529  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
24              
25 0         0 $self->verbose3("chdir($dir)");
26 0 0       0 chdir($dir) or confess "failed to chdir to $dir: $!";
27             }
28              
29 18 50   18   33702 method die (Str $str) {
  18 50   18   71  
  18 50   1   2832  
  18 50       147  
  18 50       39  
  18         1999  
  1         5  
  1         12  
  1         20  
  1         5  
  1         1  
  1         7  
  1         2  
30              
31 1         4 chomp $str;
32 1         13 die "[ERROR] $str\n";
33             }
34              
35 18 0 0 18   190651 method fatal (Str $str, Num $frames? = 0) {
  18 0   18   52  
  18 0   18   3200  
  18 0   0   126  
  18 0       39  
  18 0       2068  
  18 0       119  
  18 0       38  
  18         3253  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
36              
37 0         0 chomp $str;
38              
39 0         0 my $caller = '';
40 0 0       0 if ($frames) {
41 0         0 $caller = sprintf " %s", ( caller($frames) )[3];
42             }
43              
44 0         0 printf STDERR "[FATAL%s] $str\n", $caller;
45 0         0 exit 1;
46             }
47              
48 18 0   18   34035 method localdatetime ($time = time) {
  18 0   0   89  
  18 0       3338  
  0         0  
  0         0  
  0         0  
  0         0  
49              
50 0         0 my $l = localtime($time);
51              
52 0         0 my $str = sprintf(
53             '%04d-%02d-%02d %02d:%02d:%02d',
54             $l->year + 1900,
55             $l->mon + 1,
56             $l->mday, $l->hour, $l->min, $l->sec
57             );
58              
59 0         0 return $str;
60             }
61              
62 18 50   18   125601 method str_to_bool (Str|Undef $str) {
  18 50   18   44  
  18 50   17   2811  
  18 50       136  
  18 50       41  
  18         3491  
  17         74  
  17         92  
  17         115  
  17         112  
  17         44  
  17         122  
  17         42  
63              
64 17 50       112 if (defined $str) {
65 17 50 33     244 if ($str =~ /^true$/i or $str =~ /^yes$/i or $str eq '1') {
      33        
66 17         75 return 1;
67             }
68             }
69            
70 0           return 0;
71             }
72              
73             method system (Str :$cmd,
74             Bool :$confess_on_err = 1,
75 18 0 0 18   90957 Bool :$capture = 0) {
  18 0 0 18   68  
  18 0   18   2055  
  18 0   18   134  
  18 0   18   63  
  18 0   18   880  
  18 0   18   11107  
  18 0   0   67465  
  18 0       109  
  18 0       1715  
  18         42  
  18         5927  
  18         139  
  18         38  
  18         2314  
  18         127  
  18         41  
  18         1588  
  18         116  
  18         36  
  18         4936  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
76              
77 0           $self->verbose($cmd);
78              
79 0 0         if ($capture) {
80             my ( $stdout, $stderr, $exit ) = capture {
81 0     0     system($cmd);
82 0           };
83              
84 0 0 0       if ( $exit and $confess_on_err ) {
85 0           confess $stderr;
86             }
87              
88 0           return ( $stdout, $stderr, $exit );
89             }
90             else {
91 0           system($cmd);
92 0           my $exit = $? >> 8;
93              
94 0 0 0       if ( $exit and $confess_on_err ) {
95 0           confess "last command failed with exit code $exit";
96             }
97              
98 0           return $exit;
99             }
100             }
101              
102 18 0 0 18   63325 method verbose (Str $str, Num $frames? = 1) {
  18 0   18   43  
  18 0   18   3041  
  18 0   0   127  
  18 0       43  
  18 0       2012  
  18 0       120  
  18 0       40  
  18         1712  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
103              
104 0           $self->_verbose( 1, $str, $frames + 1 );
105             }
106              
107 18 0 0 18   60078 method verbose2 (Str $str, Num $frames? = 1) {
  18 0   18   42  
  18 0   18   3080  
  18 0   0   151  
  18 0       611  
  18 0       2094  
  18 0       121  
  18 0       38  
  18         1764  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
108              
109 0           $self->_verbose( 2, $str, $frames + 1 );
110             }
111              
112 18 0 0 18   58766 method verbose3 (Str $str, Num $frames? = 1) {
  18 0   18   457  
  18 0   18   3171  
  18 0   0   131  
  18 0       36  
  18 0       2072  
  18 0       118  
  18 0       38  
  18         1625  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
113              
114 0           $self->_verbose( 3, $str, $frames + 1 );
115             }
116              
117 18 0 0 18   57697 method warn (Str $str, Num $frames? = 1) {
  18 0   18   42  
  18 0   18   3179  
  18 0   0   123  
  18 0       34  
  18 0       1970  
  18 0       119  
  18 0       35  
  18         3085  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
118              
119 0           chomp $str;
120              
121 0           my $caller = '';
122 0 0         if ($frames) {
123 0           $caller = sprintf " %s", ( caller($frames) )[3];
124             }
125              
126 0           printf STDERR "[WARN%s] $str\n", $caller;
127             }
128              
129             ######################################################################
130              
131 18 0   18   19780 method _build_verbosity {
  18     0   42  
  18         1952  
  0            
  0            
132              
133 0           my $level = 0;
134 0 0         $level = $ENV{VERBOSE} if $ENV{VERBOSE};
135              
136 0           return $level;
137             }
138              
139 18 0 0 18   68324 method _verbose (Num $level, Str $str, Num $frames) {
  18 0 0 18   43  
  18 0   18   3026  
  18 0   18   159  
  18 0   0   50  
  18 0       2591  
  18 0       140  
  18 0       45  
  18 0       1881  
  18 0       155  
  18 0       37  
  18         3863  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
140              
141 0 0         if ( $self->verbosity >= $level ) {
142 0           chomp $str;
143 0           my $caller = ( caller($frames) )[3];
144 0           printf STDERR "[VERBOSE-%d] ($caller) $str\n", $level;
145             }
146             }
147              
148             1;