1
package Image::RenRot::Logging;
7
########################################################################################
9
########################################################################################
17
$Term::ANSIColor::AUTORESET = 1;
18
$Term::ANSIColor::EACHLINE = "\n";
19
$ENV{ANSI_COLORS_DISABLED} = 1;
21
use Image::RenRot::Util;
23
use vars qw(@ISA @EXPORT);
26
@EXPORT = qw(procmsg infomsg warnmsg errmsg fatalmsg dbgmsg ldbg3 ldbg3opts die_renrot);
29
Verbose => 0, # verbosity of output, -1 means to suppress messages
30
UseColor => 0, # whether use color output
37
debug => {value => 'green'},
38
error => {value => 'magenta'},
39
fatal => {value => 'red'},
40
info => {value => 'bold'},
41
process => {value => 'white'},
42
warning => {value => 'cyan'},
52
if ($option eq 'Color') {
53
map { $colors{$_} = $value->{$_} } keys %$value;
55
$options{$option} = $value;
59
# Setup color output properly
60
if ($options{UseColor}) {
61
delete $ENV{ANSI_COLORS_DISABLED};
63
$ENV{ANSI_COLORS_DISABLED} = 1;
67
# Prints colored message to STDERR or STDOUT
71
if ($options{UseColor} and defined $colors{$facility}) {
72
# Put process and info messages to StdOut, otherwise to StdErr
73
if ($facility eq "process" or $facility eq "info") {
74
print STDOUT colored[$colors{$facility}{value}], @_;
76
print STDERR colored[$colors{$facility}{value}], @_;
79
# fallback to normal print
80
if ($facility eq "process" or $facility eq "info") {
88
# general processing message
90
do_print('process', @_) if ($options{Verbose} >= 0);
100
do_print('warning', "Warning: ", @_);
105
do_print('error', "ERROR: ", @_);
110
do_print('fatal', "FATAL: ", @_);
116
if ($options{Verbose} >= $level) {
117
my $funcname = (caller(1))[3]; # caller() described in Perl Cookbook 10.4
118
do_print('debug', "DEBUG[$level]: ", defined $funcname ? $funcname : 'main', "(): ", @_);
122
########################################################################################
123
# Usage : ldbg3($msg, ...)
124
# Purpose : prints debug message on level 3 with EOL
126
# Parameters : text message without end of line
127
# Throws : no exceptions
128
# Comments : useful to print command line or configuration option parameters
129
# See Also : dbgmsg()
131
if ($options{Verbose} >= 3) {
132
my $funcname = (caller(1))[3]; # caller() described in Perl Cookbook 10.4
133
do_print('debug', "DEBUG[3]: ", defined $funcname ? $funcname : 'main', "(): ", @_, "\n");
137
########################################################################################
139
# ldbg3opts() prints option values from given hash
145
while (my ($k, $v) = each %{$hash->{$option}}) {
146
next if (not defined $v->{value});
148
my ($value, $default);
149
if (not defined $v->{type} or $v->{type} ne "!") {
150
$value = $v->{value};
151
$default = $v->{default};
153
$value = bool2str($v->{value});
154
$default = bool2str($v->{default});
157
if (not defined $default) {
158
ldbg3("--> '$option $k': $value");
160
ldbg3("--> '$option $k': $value (default: $default)");
165
########################################################################################
166
# Usage : die_renrot()
167
# Purpose : dies differently depend on verbose level
169
# Parameters : error message
170
# Throws : no exceptions
171
# Comments : pretty output when die with verbose level is zero
175
if ($options{Verbose} > 0) {
181
########################################################################################