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   13077 use Modern::Perl;
  18         43  
  18         178  
4 18     18   12131 use Moose::Role;
  18         99439  
  18         79  
5 18     18   103676 use namespace::autoclean;
  18         47  
  18         182  
6 18     18   1548 use Kavorka 'method';
  18         63  
  18         174  
7 18     18   11936 use Data::Printer alias => 'pdump';
  18         46  
  18         241  
8 18     18   15499 use Devel::Confess;
  18         157736  
  18         88  
9 18     18   12294 use Capture::Tiny 'capture';
  18         396171  
  18         1419  
10 18     18   9227 use Time::localtime;
  18         100215  
  18         1307  
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   48701 method chdir (Str $dir) {
  18 0   18   44  
  18 0   0   3233  
  18 0       138  
  18 0       40  
  18         2899  
  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   39449 method die (Str $str) {
  18 50   18   85  
  18 50   1   3278  
  18 50       164  
  18 50       49  
  18         2173  
  1         4  
  1         11  
  1         5  
  1         4  
  1         1  
  1         16  
  1         3  
30              
31 1         3 chomp $str;
32 1         13 die "[ERROR] $str\n";
33             }
34              
35 18 0 0 18   210478 method fatal (Str $str, Num $frames? = 0) {
  18 0   18   50  
  18 0   18   3907  
  18 0   0   205  
  18 0       46  
  18 0       2273  
  18 0       144  
  18 0       48  
  18         3437  
  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   38378 method localdatetime ($time = time) {
  18 0   0   77  
  18 0       4021  
  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   137729 method str_to_bool (Str|Undef $str) {
  18 50   18   54  
  18 50   17   3313  
  18 50       156  
  18 50       42  
  18         3971  
  17         95  
  17         83  
  17         82  
  17         92  
  17         47  
  17         143  
  17         50  
63              
64 17 50       78 if (defined $str) {
65 17 50 33     289 if ($str =~ /^true$/i or $str =~ /^yes$/i or $str eq '1') {
      33        
66 17         82 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   98341 Bool :$capture = 0) {
  18 0 0 18   55  
  18 0   18   2267  
  18 0   18   139  
  18 0   18   41  
  18 0   18   1003  
  18 0   18   12183  
  18 0   0   74802  
  18 0       132  
  18 0       2044  
  18         46  
  18         6436  
  18         157  
  18         53  
  18         2486  
  18         150  
  18         47  
  18         1751  
  18         129  
  18         37  
  18         5422  
  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   69248 method verbose (Str $str, Num $frames? = 1) {
  18 0   18   45  
  18 0   18   3475  
  18 0   0   144  
  18 0       41  
  18 0       2307  
  18 0       137  
  18 0       46  
  18         2055  
  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   66857 method verbose2 (Str $str, Num $frames? = 1) {
  18 0   18   52  
  18 0   18   3402  
  18 0   0   182  
  18 0       669  
  18 0       2346  
  18 0       138  
  18 0       40  
  18         2058  
  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   65721 method verbose3 (Str $str, Num $frames? = 1) {
  18 0   18   541  
  18 0   18   3551  
  18 0   0   154  
  18 0       42  
  18 0       2228  
  18 0       134  
  18 0       37  
  18         1896  
  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   66024 method warn (Str $str, Num $frames? = 1) {
  18 0   18   44  
  18 0   18   3617  
  18 0   0   136  
  18 0       38  
  18 0       2264  
  18 0       127  
  18 0       43  
  18         3224  
  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   22718 method _build_verbosity {
  18     0   51  
  18         2236  
  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   75773 method _verbose (Num $level, Str $str, Num $frames) {
  18 0 0 18   61  
  18 0   18   3376  
  18 0   18   187  
  18 0   0   60  
  18 0       3154  
  18 0       156  
  18 0       46  
  18 0       2030  
  18 0       132  
  18 0       50  
  18         4406  
  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;