eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#
# AAFID::Log
#
# AAFID project, COAST Laboratory, CERIAS, 1998-1999.
# 
# Diego Zamboni, Feb 21, 1998.
#
# $Id: Log.pm,v 1.11 1999/09/07 00:49:46 zamboni Exp $
#
# NOTE: This file is in Perl's POD format. For more information, see the 
#       manual page for perlpod(1).
#

package AAFID::Log;

# The following keeps up with the RCS version number. The self-assignment
# keeps the -w switch from complaining (because $VERSION may not be used
# here, but it is used in our base class).
$VERSION = do { my @r = (q$Revision: 1.11 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; $VERSION = $VERSION;

use vars qw(
	    @ISA
	    @EXPORT
	    %category_file
	    %category_length
	    $showTime
	   );
use strict;
use File::Basename;
use Log::Topics qw(log_topic add_topic topics);
use AAFID::Common;
use Exporter();

@ISA=qw(Exporter);

@EXPORT=qw(Log_register
	   Log_activate
	   Log_deactivate
	   Log_activate_full
	   Log_deactivate_full
	   Log
	  );

=pod

This package implements logging facilities for AAFID entities. The object
has to be declared as a subclass of C<AAFID::Log> (using C<@ISA=qw(AAFID::Log)>
or some equivalent). Then, the object registers the log categories it wants
to generate by using the C<Log_register> method, which takes as argument
the category name and, optionally, a filename or handle to which the logs
for that category should be sent. The entity name is obtained through its
C<ID> method, and the full category name is obtained by concatenating the
entity ID with the category provided. If no filename or handle is provided,
by default the log is sent to a file called <entity ID>log. If no category
is provided, a category called "generic" is used.

The methods can also be called directly, as non-methods. In that case,
instead of using the entity ID to build the full category name, the
package name from which the function is called is used.

When a category is registered, logging to that category is by default
deactivated. To activate logging to a category, use C<Log_activate>, which
takes a list of category names, and activates them. Categories can be
likewise deactivated using C<Log_deactivate>.

Log messages are generated through the C<Log> function, which takes as
arguments the category name and a list that contains the messages to be
logged.

Log categories can be activated (or deactivated, with a 0 instead of a file)
by their full names (without automatic detection of the caller) using
C<Log_activate_full> and C<Log_deactivate_full>.

If the category name is "debug", it is treated specially in the sense
that the filename and line number from which the message was generated
is included in the log message.

The time is printed in the log messages unless C<$AAFID::Log::showTime> is 
set to zero.

=cut

%category_file=();
%category_length=();
# By default, print time in the log messages.
$showTime=1;

sub _build_fullcategory {
  my $self=(ref($_[0])?(checkref(shift, "AAFID::Entity")):(shift,undef));
  my $category=shift || "generic";
  my $callerpackage=($self?($self->ID):((caller(1))[0]));
  return "${callerpackage}::${category}";
}

sub Log_register {
  my $self=(ref($_[0])?checkref(shift, "AAFID::Entity"):undef);
  my $category=shift || "generic";
  my $callerpackage=($self?($self->ID):((caller)[0]));
  my $file=shift || "${callerpackage}.log";
  my $fcategory="${callerpackage}::${category}";
  $category_file{$fcategory}=$file;
  $category_length{$file}=length($fcategory)+2
    if (!defined($category_length{$file}) || (length($fcategory)+2)>$category_length{$file});
  add_topic($fcategory, 0);
}

sub Log_activate {
  my $self=(ref($_[0])?checkref(shift, "AAFID::Entity"):undef);
  my $cat;
  my $fcat;
  foreach $cat (@_) {
    $fcat=_build_fullcategory($self, $cat);
    add_topic($fcat, $category_file{$fcat}) if defined($category_file{$fcat});
  }
}

sub Log_deactivate {
  my $self=(ref($_[0])?checkref(shift, "AAFID::Entity"):undef);
  my $cat;
  my $fcat;
  foreach $cat (@_) {
    $fcat=_build_fullcategory($self,$cat);
    add_topic($fcat, 0) if defined($category_file{$fcat});
  }
}

sub Log_activate_full {
  my $fcat;
  foreach $fcat (@_) {
    add_topic($fcat, $category_file{$fcat}) if defined($category_file{$fcat});
  }
}

sub Log_deactivate_full {
  my $fcat;
  foreach $fcat (@_) {
    add_topic($fcat, 0) if defined($category_file{$fcat});
  }
}

sub Log {
  my $self=(ref($_[0])?checkref(shift, "AAFID::Entity"):undef);
  my @caller=caller;
  my $category=shift || "generic";
  my $callerpackage=($self?($self->ID):($caller[0]));
  my $fcategory="${callerpackage}::${category}";
  my $format="%-".$category_length{$category_file{$fcategory}}."s";
  my $name=sprintf($format, "${callerpackage} (${category}) ");
  my $msg;
  my $callerfile=basename($caller[1], '.pm', '.pl');
  my $fline="($callerfile:$caller[2]) ";
  my $time=scalar(localtime);
  $time="" unless $AAFID::Log::showTime;
  foreach $msg (@_) {
    if ($category eq "debug") {
      log_topic($fcategory, $name, $time, " ", $fline, $msg);
    }
    else {
      log_topic($fcategory, $name, $time, " ", $msg);
    }
  }
}

1;

#
# $Log: Log.pm,v $
# Revision 1.11  1999/09/07 00:49:46  zamboni
# Moved log to the end.
#
# Revision 1.10  1999/09/03 17:08:53  zamboni
# Changed the start line to something that is path-independent, and
# updated the copyright notice.
#
# Revision 1.9  1998/06/29 20:11:23  zamboni
# Added copyright message
#
# Revision 1.8  1998/05/03 03:37:22  zamboni
# - Made Log give special treatment to the "debug" category, by including
#   in messages printed to that category the filename and line number
#   from which the message was generated (considered to be the line from
#   which the Log subroutine was called).
#
# - Added a global variable $AAFID::Log:showTime, which by default has the
#   value of 1. If it is true (nonzero), the current time is included in
#   Log messages. If it is false (zero), the time is not shown.
#
# Revision 1.7  1998/03/16 05:49:04  zamboni
# - Made log messages include filename and line number from which the message
#   was generated.
# - Temporarily removed date/time from the log messages.
#
# Revision 1.6  1998/03/13 17:00:43  zamboni
# - Added $VERSION declaration.
#
# Revision 1.5  1998/03/06 07:09:23  zamboni
# - Added "use strict"
# - Corrected a number of errors pointed out by the strict module.
#
# Revision 1.4  1998/03/04 06:34:28  zamboni
# Now it can be used either as a superclass or as a plain library. This is,
# the subroutines can be called either as methods (by inheriting from this
# class and then doing something like $self->Log), in which case the Entity
# ID is used in the log file, or as plain old subroutines (using simply Log),
# in which the caller's package name is used in the log file.
#
# Revision 1.3  1998/03/04 03:26:50  zamboni
# New version designed to be used as a superclass of the entity that does
# the logging. The messages have to be called as methods on $self.
#
# Revision 1.2  1998/02/25 07:27:08  zamboni
# Had forgotten to declare "package AAFID::Log". Added it :-)
#
# Revision 1.1  1998/02/23 05:41:35  zamboni
# Initial revision
#
