File Coverage

blib/lib/Csistck/Oper.pm
Criterion Covered Total %
statement 35 48 72.9
branch 5 12 41.6
condition 1 3 33.3
subroutine 12 13 92.3
pod 0 4 0.0
total 53 80 66.2


line stmt bran cond sub pod time code
1             package Csistck::Oper;
2              
3 17     17   314 use 5.010;
  17         49  
4 17     17   80 use strict;
  17         21  
  17         400  
5 17     17   69 use warnings;
  17         34  
  17         490  
6              
7 17     17   77 use base 'Exporter';
  17         24  
  17         1588  
8              
9             our @EXPORT_OK = qw/
10             debug error info
11             repair
12             /;
13              
14 17     17   92 use Carp;
  17         30  
  17         1346  
15 17     17   13508 use Getopt::Long;
  17         229412  
  17         141  
16 17     17   14566 use Term::ANSIColor;
  17         96728  
  17         2691  
17              
18             # Logging levels, default boolean
19             our $Modes = {
20             debug => 0,
21             error => 1,
22             info => 0
23             };
24              
25             # Boolean options
26             our $Options = {
27             verbose => 0,
28             debug => 0,
29             quiet => 0,
30             repair => 0,
31             help => 0,
32             color => 1
33             };
34              
35             # Set up colored output
36             $Term::ANSIColor::EACHLINE = "\n";
37             my $Colors = {
38             'debug' => 'black',
39             'info' => 'yellow',
40             'error' => 'red'
41             };
42              
43             # Dynamic setup of reporting functions
44             for my $level (keys %{$Modes}) {
45              
46 17     17   135 no strict 'refs';
  17         26  
  17         10995  
47              
48             *{"Csistck\::Oper\::$level"} = sub {
49 73     73   100 my $func = shift;
50              
51             # Maybe this isn't the best way. If func is passed and
52             # is code, execute. If func is passed and is a scalar,
53             # debug it?!
54 73 50 33     342 if (defined $func and $Modes->{$level}) {
55 0         0 given (ref $func) {
56 0         0 when ("CODE") { return &$func; };
  0         0  
57 0         0 when ("") { return log_message($level, $func) };
  0         0  
58             }
59             }
60             else {
61             # Return mode
62 73         176 return $Modes->{$level};
63             }
64             };
65             }
66              
67             # Repair mode accessor
68             sub repair {
69 1     1 0 3 return $Options->{repair};
70             }
71              
72             # Set up mode via command line options
73             sub set_mode_by_cli {
74              
75             # Map options (as getopt negatable option) to $Options
76             # TODO more options
77 5     5 0 6 my %opts = map { +"$_!" => \$Options->{$_} } keys %{$Options};
  30         59  
  5         16  
78 5         24 my $result = GetOptions(%opts);
79              
80             # Set reporting mode based on options
81 5 50       1413 $Modes->{info} = ($Options->{verbose}) ? 1 : 0;
82 5 50       10 $Modes->{debug} = ($Options->{debug}) ? 1 : 0;
83 5 50       16 $Modes->{error} = ($Options->{quiet}) ? 0 : 1;
84             }
85              
86             # Display usage
87             sub usage {
88 5 50   5 0 21 return undef unless ($Options->{help});
89            
90 0           print <
91             Usage: $0 [OPTION]...
92              
93             Arguments:
94            
95             --help Display usage
96             --verbose Verbose output
97             --debug Debug output
98             --repair Run repair operations
99             --quiet Less output
100             --nocolor Turn off colored output
101              
102             EOF
103 0           return 1;
104             }
105              
106             sub log_message {
107 0     0 0   my $level = shift;
108 0           my $msg = shift;
109            
110 0           my $log_line = sprintf("[%s]\ %s\n", uc($level), $msg);
111              
112 0 0         if ($Options->{color}) {
113 0           print(colored($log_line, $Colors->{$level}));
114             }
115             else {
116 0           print($log_line);
117             }
118             }
119              
120             1;