1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
package OutputMessage;
# ************************************************************
# Description : Prints information, warnings and errors.
# Author : Chad Elliott
# Create Date : 2/02/2004
# ************************************************************
# ************************************************************
# Pragmas
# ************************************************************
use strict;
# ************************************************************
# Data Section
# ************************************************************
my $debugtag = 'DEBUG: ';
my $infotag = 'INFORMATION: ';
my $warntag = 'WARNING: ';
my $errortag = 'ERROR: ';
my $debug = 0;
my $information = 0;
my $warnings = 1;
my $diagnostic = 1;
my $details = 1;
# ************************************************************
# Subroutine Section
# ************************************************************
sub new {
my $class = shift;
return bless {}, $class;
}
sub set_levels {
my $str = shift;
if (defined $str) {
$debug = ($str =~ /debug\s*=\s*(\d+)/i ? $1 : 0);
$details = ($str =~ /detail(s)?\s*=\s*(\d+)/i ? $2 : 0);
$diagnostic = ($str =~ /diag(nostic)?\s*=\s*(\d+)/i ? $2 : 0);
$information = ($str =~ /info(rmation)?\s*=\s*(\d+)/i ? $2 : 0);
$warnings = ($str =~ /warn(ing)?\s*=\s*(\d+)/i ? $2 : 0);
}
}
## Accessor for the debug setting. No parameters are necesary.
sub get_debug_level {
return $debug;
}
sub split_message {
my($self, $msg, $spc) = @_;
$msg =~ s/\n+/\n$spc/g;
$msg =~ s/\.\s+/.\n$spc/g;
return $msg . "\n";
}
sub details {
if ($details) {
#my($self, $msg) = @_;
print "$_[1]\n";
}
}
sub diagnostic {
if ($diagnostic) {
#my($self, $msg) = @_;
print "$_[1]\n";
}
}
sub debug {
if ($debug) {
#my($self, $msg) = @_;
print "$debugtag$_[1]\n";
}
}
sub information {
if ($information) {
#my($self, $msg) = @_;
print $infotag, $_[0]->split_message($_[1], ' ' x length($infotag));
}
}
sub warning {
if ($warnings) {
#my($self, $msg) = @_;
print $warntag, $_[0]->split_message($_[1], ' ' x length($warntag));
}
}
sub error {
my($self, $msg, $pre) = @_;
print STDERR '', (defined $pre ? "$pre\n" : ''), $errortag,
$self->split_message($msg, ' ' x length($errortag));
}
1;
|
