### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines 
# identifies the rest of the file as PERL for EMACS autoformatting. 
# See end of copyright for more information.
#
# 
# -------------------------------------------------------------------
#                                   X-BONE
#
#                          http://www.isi.edu/xbone
#                USC Information Sciences Institute (USC/ISI)
#                   Marina del Rey, California 90292, USA
#                          Copyright (c) 1998-2005
# 
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
# 
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
#  $RCSfile: XB_Log.pm,v $
#
# $Revision: 1.22 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:03:56 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert

package XB_Log;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw (open close log);

use strict;
use sigtrap;

use XB_Params;
use FileHandle;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Fcntl ':flock';
use FindBin;


# Flags to Log::open specyfing where the output should go.
#use constant SYSLOG => (2**0);
#use constant ERR    => (2**1);
#use constant OUT    => (2**2);
#use constant FILE   => (2**3);

# levels of debug messages allowed, log all by default
use constant N => 32;

# mask used when logging (default to log all)
my $syslog_mask = &Sys::Syslog::LOG_UPTO(&Sys::Syslog::LOG_DEBUG);

# submask used only for debug messages (default to log all)
my $debug_mask = "";
vec($debug_mask, 0, N) = (2**N-1);

# log destination (default to STDERR)
my $log_dest = $XB_Params::ERR;

# log file handle
my $log_fh;


# Description: 
#       Initialize logging, set log mask and log destinations.
# Arguments:
#	$dest	a bitmask describing where log output will go to, must be one
#		or more out of SYSLOG, ERR, OUT and FILE, or-ed together
#	$mask	which messages to print to the log later, must be a string
#		consisting of one or more of emerg, alert, crit, err, warning,
#		notice, info and debug0 ... debug128, separated by non-word
#		delimiters (if undef, log all messages)
#	$file	if $dest & FILE, this is the file name output will be appended
#		to, need not be passes otherwise
# Returns:
#	1 on success
# Exceptions:
#       "XB_Log::open" on failure
sub open($;$$) {
  my ($mask, $file);
  ($log_dest, $mask, $file) = @_;
  if(defined $mask) {
    # if a mask was passed, clear mask
    vec($debug_mask, 0, N) = 0;
    $syslog_mask = 0;
    foreach my $i (split /\W+/, $mask) {
      if($i =~ /(\D+)(\d+)?/) { 
	# for each level in the mask, set the corresponding bit
	my $sublevel = (defined $2 ? $2 : 0);
	$syslog_mask |= Sys::Syslog::LOG_MASK Sys::Syslog::xlate $1;
	# if we have a debug sublevel, add it to the mask
	if($1 =~ /debug/i) { vec($debug_mask, $sublevel+1, 1) = 1;}
      } else { die "XB_Log::open"; }
    }
  } else { vec($debug_mask, 0, N) = (2**N-1); }
  # if we're logging to syslog, initialize it
  if($log_dest & $XB_Params::SYSLOG) { 
    setlogsock('unix');
    openlog "xbone", "cons,pid", "user";
    setlogmask $syslog_mask; 
  }
  # if we are (also) logging to as file, open it
  if($log_dest & $XB_Params::FILE) { 
    if($file) { 
      $log_fh = new FileHandle;
      open $log_fh, ">>$file" or warn "cannot open log file $file: $!" 
	and die "XB_Log::open"; 
      $log_fh->autoflush;
    } else { die "XB_Log::open"; }
  }
  return 1;
}


# Description: 
#       Close log(s).
# Arguments:
#	None.
# Returns:
#	1 on success
# Exceptions:
#       "XB_Log::close" on failure
sub close () {
  # close syslog and log file, if we were using them
  if($log_dest & $XB_Params::SYSLOG) { closelog; }
  if($log_dest & $XB_Params::FILE) { close $log_fh or die "XB_Log::close"; }
  return 1;
}


# Description: 
#       Write a printf style message to the logs, if $level matches the mask
#	passed to XB_Log::open before.
# Arguments:
#	$level	level of the message, must be a string consisting of one out 
#		of emerg, alert, crit, err, warning, notice, info and 
#		debug0 ... debug128
#	@args   a printf-style array containing the message to be logged
# Returns:
#	1 on success
# Exceptions:
#       "XB_Log::log" on failure
sub log ($@) {
  my ($level, @args) = @_;
  my $sublevel = 0;
  my $at = $@;

  unless($level =~ /^(emerg|alert|crit|err|warning|notice|info|debug(\d+)?)$/) {
    warn "XB_Log::log: unknown log level \"$level\"" and die "XB_Log::log"; 
  }
  # if @args is empty, there's nothing to log
  return unless scalar @args;
  # if we have one of our homegrown debug levels to log, grab the sublevel
  if($level =~ /debug(\d+)/) { ($level, $sublevel) = ("debug", $1); }
  # are we suppposed to print this?
  if(not defined $syslog_mask or 
     $syslog_mask & Sys::Syslog::LOG_MASK Sys::Syslog::xlate $level and
     ($level !~ /debug/i or vec($debug_mask, $sublevel+1, 1))) {
    # ok, print it to log(s)
    my $msg = ($#args ? sprintf shift @args, @args : $args[0]);
    chomp $msg;
    if($log_dest & $XB_Params::SYSLOG) { 
      foreach my $line (split /\n/, $msg) { 
	if($line and $line ne "\n") { syslog $level, $line; }
      }
    }
    if($log_dest & $XB_Params::ERR) { print STDERR "$msg\n"; }
    if($log_dest & $XB_Params::OUT) { print STDOUT "$msg\n"; }
    # if we print to a file, add syslog-like timestamp
    my $prefix = scalar(localtime) . " $FindBin::Script\[$$\]: ";
    if($log_dest & $XB_Params::FILE) { 
      flock $log_fh, LOCK_EX or die "XB_Log::log";
      foreach my $line (split /\n/, $msg) { 
	if($line and $line ne "\n") { print $log_fh "$prefix$line\n"; }
      }
      flock $log_fh, LOCK_UN or die "XB_Log::log";
    }

    # save "err" log to $XB_Params::error_reply as a shortcut to pass
    # error logs to the caller in case we die right after "err" log
    # (append
    if($level =~ /err/){
      if(($XB_Params::error_reply eq "") or $XB_Params::APPEND_ERR_LOG){
        $XB_Params::error_reply .= "$msg\n";
      }
    }
  }
  # restore global variables
  $@ = $at;
  return 1;
}


1;