my ($error_color, $warning_color, $command_color, $highlight_color, $normal) = "";
-my $me;
+our $me;
BEGIN {
# Extract relative path and basename from script name.
$me = $FindBin::Script;
-
+
# Remove .pl for Perl scripts that have that extension
$me =~ s/\.pl$//;
} # BEGIN
-sub new (;%){
+sub new(;%) {
my ($class, %parms) = @_;
=pod
my $disposition = $parms{disposition} ? $parms{disposition} : 'perm';
my $timestamped = $parms{timestamped} ? $parms{timestamped} : 'FALSE';
my $append = $parms{append} ? '>>' : '>';
- my $extension = $parms{extension} ? $parms{extension} : 'log';
my $logfile;
- $name = "$name.$extension";
+ if (defined $parms{extension}) {
+ $name .= ".$parms{extension}" unless $parms{extension} eq '';
+ } else {
+ $name .= '.log';
+ } # if
open $logfile, $append, "$path/$name"
or error "Unable to open logfile $path/$name - $!", 1;
# Set unbuffered output
- $logfile->autoflush ();
+ $logfile->autoflush();
- set_verbose
- if $ENV{VERBOSE};
- set_debug
- if $ENV{DEBUG};
+ set_verbose if $ENV{VERBOSE};
+ set_debug if $ENV{DEBUG};
return bless {
path => $path,
}, $class; # bless
} # new
-sub append ($) {
+sub append($) {
my ($self, $filename) = @_;
=pod
} # while
close $file;
-
+
return;
} # append
-sub name () {
+sub name() {
my ($self) = @_;
-
+
=pod
=head3 name
return $self->{name};
} # name
-sub fullname () {
+sub fullname() {
my ($self) = @_;
-
+
=pod
=head3 fullname
return "$self->{path}/$self->{name}";
} # fullname
-sub msg ($;$) {
+sub msg($;$) {
my ($self, $msg, $nolinefeed) = @_;
=pod
=cut
$self->log ($msg, $nolinefeed);
-
+
verbose $msg, undef, $nolinefeed;
-
+
return;
} # msg
-sub disp ($;$) {
+sub disp($;$) {
my ($self, $msg, $nolinefeed) = @_;
=pod
=cut
$self->log ($msg, $nolinefeed);
-
+
display $msg, undef, $nolinefeed;
-
+
return;
} # disp
-sub incrementErr (;$) {
+sub incrementErr(;$) {
my ($self, $increment) = @_;
=pod
=cut
$increment ||= 1;
-
+
$self->{errors} += $increment;
+
+ return;
} # incrementErr
-sub err ($;$) {
+sub err($;$) {
my ($self, $msg, $errno) = @_;
-
+
=pod
=head3 err ($msg, $errno)
$msg = "ERROR: $msg";
} # if
- $self->log ($msg);
-
+ $self->msg($msg);
+
$self->incrementErr;
-
+
exit $errno if $errno;
-
+
return;
} # err
-sub maillog (%) {
+sub maillog(%) {
my ($self, %parms) = @_;
=pod
my $footing = $parms{footing};
my $mode = $parms{mode};
- $mode = "plain"
- unless $mode;
+ $mode = "plain" unless $mode;
my $log_filename = "$self->{path}/$self->{name}";
. $footing;
} # if
- mail (
+ mail(
from => $from,
to => $to,
cc => $cc,
footing => $footing,
data => $logfile
);
-
+
close $logfile
or error "Unable to close logfile $log_filename", 1;
-
+
return;
} # maillog
-sub log {
+sub log($;$) {
my ($self, $msg, $nolinefeed) = @_;
=pod
$msg = "$me: " . YMDHM . ": $msg" if $self->{timestamped};
display $msg, $self->{handle}, $nolinefeed;
-
+
return;
} # log
-sub logcmd ($) {
+sub logcmd($) {
my ($self, $cmd) = @_;
=pod
return ($?, @output);
} # logcmd
-sub loglines () {
+sub loglines() {
my ($self) = @_;
-
+
=pod
=head3 loglines
return ReadFile "$self->{path}/$self->{name}";
} # loglines
-sub warn ($;$) {
+sub warn($;$) {
my ($self, $msg, $warnno) = @_;
=pod
=cut
warning $msg, $warnno;
-
+
if ($warnno) {
$msg = "WARNING #$warnno: $msg";
} else {
$self->log ($msg);
$self->{warnings}++;
-
+
return;
} # warn
-sub errors () {
+sub errors() {
my ($self) = @_;
-
+
=pod
=head3 errors ()
return $self->{errors};
} # errors
-sub warnings () {
+sub dbug($) {
+ my ($self, $msg) = @_;
+
+ $self->log("DEBUG: $msg") if get_debug;
+
+ return;
+} # dbug
+
+sub warnings() {
my ($self) = @_;
-
+
=pod
=head3 warnings ()
return $self->{warnings};
} # warnings
-sub DESTROY () {
+sub DESTROY() {
my ($self) = @_;
close ($self->{handle});
if ($self->{disposition} eq 'temp') {
if ($self->{errors} == 0 and
- $self->{warnings} == 0) {
+ $self->{warnings} == 0) {
unlink $self->fullname;
} # if
} # if
-
+
return;
} # destroy