~ubuntu-branches/ubuntu/vivid/renrot/vivid-proposed

« back to all changes in this revision

Viewing changes to lib/Image/RenRot/Logging.pm

  • Committer: Package Import Robot
  • Author(s): Ondřej Surý
  • Date: 2014-10-06 14:04:27 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20141006140427-ax0dwq886zjo2x3r
Tags: 1.2.0-0.1
* Non-maintainer upload
* New upstream version 1.2.0 (Closes: #402702, #729630, #539346)
* Don't depend on versioned libjpeg-progs (Closes: #764215)

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
package Image::RenRot::Logging;
 
2
 
 
3
#
 
4
# vim: ts=2 sw=2 et :
 
5
#
 
6
 
 
7
########################################################################################
 
8
###                                 MESSAGING                                        ###
 
9
########################################################################################
 
10
 
 
11
use strict;
 
12
use warnings;
 
13
require 5.006;
 
14
require Exporter;
 
15
use Term::ANSIColor;
 
16
 
 
17
$Term::ANSIColor::AUTORESET = 1;
 
18
$Term::ANSIColor::EACHLINE = "\n";
 
19
$ENV{ANSI_COLORS_DISABLED} = 1;
 
20
 
 
21
use Image::RenRot::Util;
 
22
 
 
23
use vars qw(@ISA @EXPORT);
 
24
 
 
25
@ISA = qw(Exporter);
 
26
@EXPORT = qw(procmsg infomsg warnmsg errmsg fatalmsg dbgmsg ldbg3 ldbg3opts die_renrot);
 
27
 
 
28
my %options = (
 
29
  Verbose   => 0, # verbosity of output, -1 means to suppress messages
 
30
  UseColor  => 0, # whether use color output
 
31
);
 
32
 
 
33
#
 
34
# Colors hash
 
35
#
 
36
my %colors = (
 
37
  debug   => {value => 'green'},
 
38
  error   => {value => 'magenta'},
 
39
  fatal   => {value => 'red'},
 
40
  info    => {value => 'bold'},
 
41
  process => {value => 'white'},
 
42
  warning => {value => 'cyan'},
 
43
);
 
44
 
 
45
sub set {
 
46
  my $self = shift;
 
47
 
 
48
  while (@_) {
 
49
    my $option = shift;
 
50
    my $value = shift;
 
51
 
 
52
    if ($option eq 'Color') {
 
53
      map { $colors{$_} = $value->{$_} } keys %$value;
 
54
    } else {
 
55
      $options{$option} = $value;
 
56
    }
 
57
  }
 
58
 
 
59
  # Setup color output properly
 
60
  if ($options{UseColor}) {
 
61
    delete $ENV{ANSI_COLORS_DISABLED};
 
62
  } else {
 
63
    $ENV{ANSI_COLORS_DISABLED} = 1;
 
64
  }
 
65
}
 
66
 
 
67
# Prints colored message to STDERR or STDOUT
 
68
sub do_print {
 
69
  my $facility = shift;
 
70
 
 
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}], @_;
 
75
    } else {
 
76
      print STDERR colored[$colors{$facility}{value}], @_;
 
77
    }
 
78
  } else {
 
79
    # fallback to normal print
 
80
    if ($facility eq "process" or $facility eq "info") {
 
81
      print STDOUT @_;
 
82
    } else {
 
83
      print STDERR @_;
 
84
    }
 
85
  }
 
86
}
 
87
 
 
88
# general processing message
 
89
sub procmsg {
 
90
  do_print('process', @_) if ($options{Verbose} >= 0);
 
91
}
 
92
 
 
93
# information message
 
94
sub infomsg {
 
95
  do_print('info', @_);
 
96
}
 
97
 
 
98
# warning message
 
99
sub warnmsg {
 
100
  do_print('warning', "Warning: ", @_);
 
101
}
 
102
 
 
103
# error message
 
104
sub errmsg {
 
105
  do_print('error', "ERROR: ", @_);
 
106
}
 
107
 
 
108
# fatal message
 
109
sub fatalmsg {
 
110
  do_print('fatal', "FATAL: ", @_);
 
111
}
 
112
 
 
113
# debug message
 
114
sub dbgmsg {
 
115
  my $level = shift;
 
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', "(): ", @_);
 
119
  }
 
120
}
 
121
 
 
122
########################################################################################
 
123
# Usage      : ldbg3($msg, ...)
 
124
# Purpose    : prints debug message on level 3 with EOL
 
125
# Returns    : nothing
 
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()
 
130
sub ldbg3 {
 
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");
 
134
  }
 
135
}
 
136
 
 
137
########################################################################################
 
138
#
 
139
# ldbg3opts() prints option values from given hash
 
140
#
 
141
sub ldbg3opts {
 
142
  my $hash = shift;
 
143
  my $option = shift;
 
144
 
 
145
  while (my ($k, $v) = each %{$hash->{$option}}) {
 
146
    next if (not defined $v->{value});
 
147
 
 
148
    my ($value, $default);
 
149
    if (not defined $v->{type} or $v->{type} ne "!") {
 
150
      $value = $v->{value};
 
151
      $default = $v->{default};
 
152
    } else {
 
153
      $value = bool2str($v->{value});
 
154
      $default = bool2str($v->{default});
 
155
    }
 
156
 
 
157
    if (not defined $default) {
 
158
      ldbg3("--> '$option $k': $value");
 
159
    } else {
 
160
      ldbg3("--> '$option $k': $value (default: $default)");
 
161
    }
 
162
  }
 
163
}
 
164
 
 
165
########################################################################################
 
166
# Usage      : die_renrot()
 
167
# Purpose    : dies differently depend on verbose level
 
168
# Returns    : nothing
 
169
# Parameters : error message
 
170
# Throws     : no exceptions
 
171
# Comments   : pretty output when die with verbose level is zero
 
172
# See Also   : n/a
 
173
sub die_renrot {
 
174
  fatalmsg (@_);
 
175
  if ($options{Verbose} > 0) {
 
176
    die("Fatal");
 
177
  }
 
178
  exit 127;
 
179
}
 
180
 
 
181
########################################################################################
 
182
1;  # end