#! /local/bin/perl

######################################################################
# $Header: /loc/adm/slink-1.0/src/slink-5.0/Slink/RCS/Logger.pm,v 5.0 1996/05/13 17:14:27 couch Exp $
#  Slink::Logger.pm: general error and event logging mechanisms.
#  Revision 5.0
#  by
#  Alva L. Couch,                       
#  Associate Prof. of EE/CS          
#  Department of EE/CS             
#  Tufts University,            
#  Medford, Massachusetts, 02155.
#  couch@cs.tufts.edu
#
#  Copyright (C) 1996 by Alva L. Couch 
#
#  This file is part of SLINK
#
#  SLINK is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
#
#  SLINK is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with GNU CC; see the file COPYING.  If not, write to
#  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
######################################################################

package Slink::Logger; 
require 5.001;
require Exporter;
require 'ctime.pl'; 
use Cwd; 
use Slink::Omniopter; 
use strict; 
no strict 'refs'; 

sub BEGIN {
    @Slink::Logger::ISA = qw(Exporter);
    @Slink::Logger::EXPORT = qw();
    @Slink::Logger::EXPORT_OK 
	= (qw(debug debug_start debug_part debug_end),
	   qw(verbose verbose_start verbose_part verbose_end),
	   qw(mesg mesg_start mesg_part mesg_end),
	   qw(error error_start error_part error_end),
	   qw(warning warning_start warning_part warning_end),
	   qw(cerror cverbose options logging erring));

    # we have no instances yet. This counter is bumped every time we
    # create an instance of Slink::Logger, to insure unique filehandles. 
    $Slink::Logger::instances = 0; 
}; 

# open a new instance of the logger by 
# gensyming two file handles and instantiating them
sub new {
    my ($pack,$options) = @_; 

    $options = {} if ! defined $options; 

    my @illegal = &Slink::Omniopter::illegal($options, 
	'logfile', 'errfile', 'verbose', 'echo', 'debug', 'label', 
	'confile', 'confline', 'conflineno', 'quiet'); 
    if (@illegal) {
	my $illegal = join (' ',@illegal); 
	print STDERR "Slink::Logger: illegal options $illegal!\n"; 
    }

    my ($label) = $options->{'label'}; 
    $label = 'program' if ! defined $label;
    $options->{'label'} = $label; 

    $Slink::Logger::instances++; 

    my $date = &ctime(time); chop $date; 

    my $logfile = $options->{'logfile'}; 
    my $logFD;
    if (defined ($logfile)) {
	$logFD = sprintf "LOGGER%03dLOG",$Slink::Logger::instances; 
	open($logFD,">>$logfile") 
	  || die "cannot append to log file $logfile: $!";
	print $logFD "$label started by $ENV{'USER'} on $date\n"; 
    } else {
	$logFD = undef; 
    }

    my $errfile = $options->{'errfile'}; 
    my $errFD; 
    if (defined ($errfile)) {
	$errFD = sprintf "LOGGER%03dERR",$Slink::Logger::instances; 
	open($errFD,">>$errfile") 
	    || die "cannot append to error file $errfile: $!"; 
	print $errFD "$label started by $ENV{'USER'} on $date\n"; 
    } else {
	$errFD = undef; 
    }
    return bless [$logFD,$errFD,$options]; 
}

# this subroutine insures that options in an option list 
# match options we're expecting 
sub omniopter {
    my($ref,@allopts) = @_; 
    my %newref = %$ref; 
    my $thing; 
    foreach $thing (@allopts) { delete $newref{$thing}; }
    my @extras = keys %newref; 
    if (@extras) {
	my $extras = join (' ',@extras); 
	print STDERR "Slink::Logger: options $extras not recognised\n"; 
	return 0; 
    } else {
	return 1; 
    }
}

sub LOG     { 
    die "invalid ref" if ref($_[0]) ne "Slink::Logger"; 
    return $_[0]->[0]; 
}
sub ERR     { 
    die "invalid ref" if ref($_[0]) ne "Slink::Logger"; 
    return $_[0]->[1]; 
}
sub logging { 
    die "invalid ref" if ref($_[0]) ne "Slink::Logger"; 
    return defined $_[0]->[0]; 
}
sub erring  { 
    die "invalid ref" if ref($_[0]) ne "Slink::Logger"; 
    return defined $_[0]->[1]; 
}
sub options { 
    die "invalid ref" if ref($_[0]) ne "Slink::Logger"; 
    return $_[0]->[2]; 
}

sub close { 
    my ($this) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    close($this->LOG) if $this->logging; 
    close($this->ERR) if $this->erring; 
}

###########################################################
# normal message log indicates actions taken
# this can be done with one call or a series of calls
# $log->mesg_start("beginning"); 
# $log->mesg_part("middle part"); (any number of times)
# $log->mesg_end("ending"); 
###########################################################

#print a whole log message
sub mesg {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $log = $this->LOG; 
    print $log "$message\n" if $this->logging; 
    if ($this->options->{'echo'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print STDERR "$message\n"; 
    }
    return 1; 
}

# print the preamble of a log message
sub mesg_start {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $log = $this->LOG; 
    print $log "$message" if $this->logging; 
    if ($this->options->{'echo'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print STDERR "$message"; 
    }
    return 1; 
}

# print a middle part of a log message
sub mesg_part { 
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $log = $this->LOG; 
    print $log $message if $this->logging; 
    if ($this->options->{'echo'}) {
	print STDERR $message; 
    }
    return 1; 
}

# print the end of a log message
sub mesg_end { 
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $log = $this->LOG; 
    print $log "$message\n" if $this->logging; 
    if ($this->options->{'echo'}) {
	print STDERR "$message\n"; 
    }
    return 1; 
}

###########################################################
# verbose log indicates intent before doing something
# or messages not part of standard error reporting
# this can be done with one call or a series of calls
# $log->verbose_start("beginning"); 
# $log->verbose_part("middle part"); (any number of times)
# $log->verbose_end("ending"); 
###########################################################

# enter a verbose message
sub verbose {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'verbose'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print STDERR "$message\n";
    }
    return 1; 
}

# start a verbose message
sub verbose_start {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'verbose'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
        print STDERR "$message";
    }
    return 1; 
}

# enter part of a verbose message
sub verbose_part {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'verbose'}) {
	print STDERR "$message";
    }
    return 1; 
}

# end a verbose message
sub verbose_end {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'verbose'}) {
	print STDERR "$message\n";
    }
    return 1; 
}

###########################################################
# warnings print a warning message that's not fatal
# this is essentially a verbose message except
# that the return value is 0. 
# this can be done with one call or a series of calls
# $log->warning_start("beginning"); 
# $log->warning_part("middle part"); (any number of times)
# $log->warning_end("ending"); 
###########################################################

sub warning       { verbose(@_);       return 0; }
sub warning_start { verbose_start(@_); return 0; }
sub warning_part  { verbose_part(@_);  return 0; }
sub warning_end   { verbose_end(@_);   return 0; }

###########################################################
# debug logger tells about internal operations
# this can be done with one call or a series of calls
# $log->debug_start("beginning"); 
# $log->debug_part("middle part"); (any number of times)
# $log->debug_end("ending"); 
###########################################################

# one debugging message
sub debug {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'debug'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print STDERR "$message\n";
    }
    return 1; 
}

# this begins a debugging message by stamping it
sub debug_start { 
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'debug'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print STDERR "$message";
    }
    return 1; 
}

# this prints PART of a debugging message, without the label or \n
sub debug_part {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'debug'}) {
	print STDERR "$message";
    }
    return 1; 
}

# this prints the end of a single debugging message
sub debug_end {
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->options->{'debug'}) {
	print STDERR "$message\n";
    }
    return 1; 
}
    
###########################################################
# general error logger informs about errors
# this can be done with one call or a series of calls
# $log->error_start("beginning"); 
# $log->error_part("middle part"); (any number of times)
# $log->error_end("ending"); 
###########################################################

# one error message
sub error {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $err = $this->ERR; 
    print $err "$message\n" if $this->erring; 
    if (! $this->erring || ! $this->options->{'quiet'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print "$message\n";
    }
    return 0;
}

# beginning of one error message
sub error_start {
    my($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $err = $this->ERR; 
    print $err "$message" if $this->erring; 
    if (! $this->erring || ! $this->options->{'quiet'}) {
	my $label = $this->options->{'label'}; 
	print STDERR "$label: " if defined $label; 
	print STDERR "$message";
    }
    return 0;
}

# print part of an error message
sub error_part { 
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $err = $this->ERR; 
    print $err $message if $this->erring; 
    if (! $this->erring || ! $this->options->{'quiet'}) {
	print STDERR $message;
    }
    return 0; 
}

# print the end of an error message
sub error_end { 
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    my $err = $this->ERR; 
    print $err "$message\n" if $this->erring; 
    if (! $this->erring || ! $this->options->{'quiet'}) {
	print STDERR "$message\n";
    }
    return 0; 
}

# This special error form informs the user of configuration file errors, 
# showing the position of the offending line in the configuration file. 
# Preconditions: there are option values for 
# `confline', 'conflineno', and `confile', 
# Postconditions: the error is described in $this->ERR along with the 
# line in the configuration file that caused it. 
sub cerror {
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->erring) {
	my $label      = $this->options->{'label'}; 
	my $confile    = $this->options->{'confile'};
	my $conflineno = $this->options->{'conflineno'};
	my $confline   = $this->options->{'confline'};
	my $err = $this->ERR; 
        print $err "$label: " if defined $label; 
        print $err "file $confile," if defined $confile; 
	print $err "line $conflineno," if defined $conflineno; 
        print $err "\n" if defined $confile || defined $conflineno; 
	print $err " line contents: $confline\n" if defined $confline;
	print $err " $message\n"; 
    } 
    if (! $this->erring || ! $this->options->{'quiet'}) {
	my $label      = $this->options->{'label'};
	my $confile    = $this->options->{'confile'};
	my $conflineno = $this->options->{'conflineno'};
	my $confline   = $this->options->{'confline'};
        print STDERR "$label: " if defined $label; 
        print STDERR "file $confile," if defined $confile; 
	print STDERR "line $conflineno," if defined $conflineno; 
        print STDERR "\n" if defined $confile || defined $conflineno; 
	print STDERR " line contents: $confline\n" if defined $confline;
	print STDERR " $message\n"; 
    }
    return 0; 
}

# alternative routine logs a verbose message about a configuration file line,
# with the same message format as the above. 

sub cverbose {
    my ($this,$message) = @_; 
    die "invalid ref" if ref($this) ne "Slink::Logger"; 
    if ($this->verbose) {
	my $confile =    $this->options->{'confile'}; 
	my $conflineno = $this->options->{'conflineno'}; 
	my $confline =   $this->options->{'confline'}; 
	my $label =      $this->options->{'label'}; 
        print STDERR "$label: " if defined $label; 
        print STDERR "file $confile," if defined $confile; 
	print STDERR "line $conflineno," if defined $conflineno; 
        print STDERR "\n" if defined $confile || defined $conflineno; 
	print STDERR " line contents: $confline\n" if defined $confline;
	print STDERR " $message\n"; 
    }
    return 1; 
}

1;