windows-server-2003/tools/logmsg.pm

#---------------------------------------------------------------------
package Logmsg;
#
#   Copyright (c) Microsoft Corporation. All rights reserved.
#
# Version:
#  2.00 07/20/2000 JeremyD: new version
#  2.01 12/27/2000 JeremyD: remove compatibility hooks
#  2.02 02/02/2001 JeremyD: add logfile_append function
#---------------------------------------------------------------------
use strict;
use vars qw(@ISA @EXPORT $VERSION $DEBUG);
use Carp;
use Exporter;
use Win32::Mutex;
use IO::File;
use File::Basename;
@ISA = qw(Exporter);
@EXPORT = qw(dbgmsg infomsg logmsg wrnmsg errmsg timemsg append_file);

$VERSION = '2.02';


sub timestamp() {
    my ($sec,$min,$hour,$day,$mon,$year) = localtime;
    $year %= 100;
    $mon++;
    return sprintf("%02d/%02d/%02d %02d:%02d:%02d",
                   $mon, $day, $year, $hour, $min, $sec);
}

sub scriptname() {
    $ENV{SCRIPT_NAME} || basename($0);
}

sub sync_write {
    my $data = shift;
    my $filename = shift;

    # validate data
    return unless $data;
    return unless $filename;

    # get a global mutex for this file, this breaks down if
    #   relative paths are used, so don't use them
    my $mutexname = $filename;
    $mutexname =~ tr/A-Z\\/a-z\//;
    $mutexname = "Global\\$mutexname";

    my $mutex = Win32::Mutex->new(0, $mutexname);
    if (defined $mutex) {
        if ($mutex->wait(60000)) {
            if (my $fh = IO::File->new($filename, "a")) {
                $fh->print($data);
                undef $fh;
            } else {
                carp "Failed to open $filename: $!";
            }
            $mutex->release;
        } else {
            carp "Timed out trying to get mutex for $filename, ".
                 "skipping";
        }
    } else {
        carp "Failed to create mutex $mutexname for log access";
    }
}

sub sync_write_multiple {
    my $data = shift;
    my @filenames = @_;
    for my $filename (@filenames) {
        sync_write($data, $filename);
    }
}


sub dbgmsg {
    my $message = shift;
    return unless ($DEBUG or $ENV{DEBUG});
    my $line = sprintf("(%s) [%s] %s\n",
                       scriptname(), timestamp(), $message);
    print $line;
    sync_write_multiple($line,
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    return $line;
}


sub infomsg {
    my $message = shift;
    my $line = sprintf("(%s) [%s] %s\n",
                       scriptname(), timestamp(), $message);
    sync_write_multiple($line,
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    return $line;
}


sub logmsg {
    my $message = shift;
    my $line = sprintf("(%s) %s\n",
                       scriptname(), $message);
    print $line;
    sync_write_multiple($line,
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    return $line;
}

sub timemsg {
    my $message = shift;
    my $line = sprintf("(%s) [%s] %s\n",
                       scriptname(), timestamp(), $message);
    print $line;
    sync_write_multiple($line,
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    return $line;
}

sub wrnmsg {
    my $message = shift;
    my $line = sprintf("(%s) WARNING: %s\n",
                       scriptname(), $message);
    print $line;
    sync_write_multiple($line,
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    return $line;
}

sub errmsg {
    my $message = shift;
    my $line = sprintf("(%s) ERROR: %s\n",
                       scriptname(), $message);
    print $line;
    sync_write_multiple($line,
                        $ENV{ERRFILE},
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    $ENV{ERRORS}++;
    return $line;
    # maybe this should croak?
}

sub append_file {
    my $filename = shift;
    my $shortname = basename($filename);
    my $content = sprintf("(%s) [%s] appending %s\n",
                          scriptname(), timestamp(), $filename);

    open FILE, $filename or die $!;
    while (<FILE>) {
        $content .= "$shortname: $_";
    }
    close FILE;

    sync_write_multiple($content,
                        $ENV{LOGFILE},
                        $ENV{INTERLEAVE_LOG});
    return $filename;
}

1;

__END__

=head1 NAME

Logmsg - An interface for writing to log files

=head1 SYNOPSIS

  use Logmsg;
  logmsg "the text to be logged";

=head1 DESCRIPTION

The Logmsg module provides an interface for writing to log files.

The functions exported by Logmsg all take exactly one scalar, the
message to be logged and return the text that was logged.

The name of the running script is logged at the beginning of each
message. The script name is set to either the SCRIPT_NAME environment
variable or $0 if SCRIPT_NAME is not set.

If a filename is available but the file does not exist it will be
created.

If a logfile environment variable (LOGFILE, INTERLEAVE_LOG, ERRFILE)
is not set no attempt will be made to log to the file that it doesn't
specify. No error or warning is generated.

Any files that cannot be logged to (unable to obtain a lock within
timeout) are skipped printing a warning to STDERR.

=over 4


=item logmsg( $message )

Logs to STDOUT and the files specified by LOGFILE and INTERLEAVE_LOG.

=item errmsg( $message )

Logs to STDOUT and the files specified by ERRFILE, LOGFILE and
INTERLEAVE_LOG. The message text is preceeded by "ERROR: " and the
ERRORS environment variable is incremented.

=item wrnmsg( $message )

Logs to STDOUT and the files specified by LOGFILE and INTERLEAVE_LOG.
The message text is preceeded by "WARNING: ".

=item infomsg( $message )

Logs to files specified by LOGFILE and INTERLEAVE_LOG. infomsg is
similar to logmsg but can be used when output to STDOUT is not
desirable.

=item dbgmsg( $message )

Logs to STDOUT and the files specified by LOGFILE and INTERLEAVE_LOG
only if $Logmsg::DEBUG or the DEBUG environment variable is set.

=item timemsg( $message )

Logs to STDOUT and the files specified by LOGFILE and INTERLEAVE_LOG.
The message text is preceeded by a date/time stamp.

=item append_file( $filename )

The contents of $filename are appended to LOGFILE and INTERLEAVE_LOG.
The time and filename passed in are logged first followed by the
contents of the file. Each line is prefixed with the filename without
the path.

=back

=head1 ENVIRONMENT

The environment variable SCRIPT_NAME is used to determine the script
name to be logged with each message. The base filename of $0 is used
if this is not set.

If neither the DEBUG environment variable nor $Logfile::DEBUG is set
then dbgmsg returns immediately and does not log.

The environment variables LOGFILE, INTERLEAVE_LOG and ERRFILE specify
the filenames to be used for logging. Any or all of these may be left
unset without generating a warning or error.

The errmsg function increments the ERRORS environment variable each
time it is called.

=head1 NOTES

All file access is syncronized with a mutex based on the filename
given. If different relative paths are used for a single file then
locking protection will not work. In this case it is possible that
some data may be corrupted by simultaneous writes to the same file.

=head1 AUTHOR

Jeremy Devenport <JeremyD>

=head1 COPYRIGHT

Copyright (c) Microsoft Corporation. All rights reserved.

=cut