X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FLogger.pm;h=68fa8971b82ecc421fd552c0a3e997319d2a746b;hb=99ca384d4edaba6a359e5d31c8e6cecbfc70877f;hp=c4d8452ede58a0eb219616bafe6f3af4010802da;hpb=020a4a5ea2be725b155cae3a2cadc9aba3911b9b;p=clearscm.git diff --git a/lib/Logger.pm b/lib/Logger.pm index c4d8452..68fa897 100644 --- a/lib/Logger.pm +++ b/lib/Logger.pm @@ -88,7 +88,7 @@ my $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 @@ -164,10 +164,13 @@ Returns: 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; @@ -175,10 +178,8 @@ Returns: # Set unbuffered output $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, @@ -236,13 +237,13 @@ Returns: } # while close $file; - + return; } # append sub name () { my ($self) = @_; - + =pod =head3 name @@ -280,7 +281,7 @@ Returns: sub fullname () { my ($self) = @_; - + =pod =head3 fullname @@ -359,9 +360,9 @@ Returns: =cut $self->log ($msg, $nolinefeed); - + verbose $msg, undef, $nolinefeed; - + return; } # msg @@ -408,9 +409,9 @@ Returns: =cut $self->log ($msg, $nolinefeed); - + display $msg, undef, $nolinefeed; - + return; } # disp @@ -452,13 +453,15 @@ Returns: =cut $increment ||= 1; - + $self->{errors} += $increment; + + return; } # incrementErr sub err ($;$) { my ($self, $msg, $errno) = @_; - + =pod =head3 err ($msg, $errno) @@ -511,11 +514,11 @@ Returns: } # if $self->log ($msg); - + $self->incrementErr; - + exit $errno if $errno; - + return; } # err @@ -591,10 +594,10 @@ Returns: footing => $footing, data => $logfile ); - + close $logfile or error "Unable to close logfile $log_filename", 1; - + return; } # maillog @@ -644,7 +647,7 @@ Returns: $msg = "$me: " . YMDHM . ": $msg" if $self->{timestamped}; display $msg, $self->{handle}, $nolinefeed; - + return; } # log @@ -685,7 +688,7 @@ Returns: display "\$ $cmd", $self->{handle} if get_debug; - my $status = open my $output, '|', "$cmd 2>&1"; + my $status = open my $output, '-|', "$cmd 2>&1"; if (!$status) { $self->{error}++; @@ -709,7 +712,7 @@ Returns: sub loglines () { my ($self) = @_; - + =pod =head3 loglines @@ -789,7 +792,7 @@ Returns: =cut warning $msg, $warnno; - + if ($warnno) { $msg = "WARNING #$warnno: $msg"; } else { @@ -798,13 +801,13 @@ Returns: $self->log ($msg); $self->{warnings}++; - + return; } # warn sub errors () { my ($self) = @_; - + =pod =head3 errors () @@ -842,7 +845,7 @@ Returns: sub warnings () { my ($self) = @_; - + =pod =head3 warnings () @@ -885,11 +888,11 @@ sub DESTROY () { if ($self->{disposition} eq 'temp') { if ($self->{errors} == 0 and - $self->{warnings} == 0) { + $self->{warnings} == 0) { unlink $self->fullname; } # if } # if - + return; } # destroy @@ -913,15 +916,15 @@ L =head3 ClearSCM Perl Modules -=for html

DateUtils

+=for html

DateUtils

-=for html

Display

+=for html

Display

-=for html

Mail

+=for html

Mail

-=for html

OSDep

+=for html

OSDep

-=for html

Utils

+=for html

Utils

=head2 INCOMPATABILITIES