# -*- perl -*-
#
# $Id: Logger.pm,v 1.5 1998/03/27 22:17:48 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/Logger.pm,v $
# $Author: ejb $
#

require 5.002;
use strict;

package Logger;
my $package = "Logger";

use POSIX qw(:signal_h);

# Field names
my $f_whoami = "whoami";
my $f_logpid = "logpid";
my $f_stdout = "stdout";
my $f_stderr = "stderr";
my $f_mypid = "mypid";
my $f_logfile = "logfile";

# Static Variables

# Routines

sub new
{
    my $class = shift;
    my $whoami = shift;
    my $rep = +{$package => {} };

    $| = 1;

    local(*SAVESTDOUT);
    local(*SAVESTDERR);

    open(SAVESTDOUT, ">&STDOUT");
    open(SAVESTDERR, ">&STDERR");

    $rep->{$package}{$f_whoami} = $whoami;
    $rep->{$package}{$f_logpid} = 0;
    $rep->{$package}{$f_stdout} = *SAVESTDOUT;
    $rep->{$package}{$f_stdout} = *SAVESTDERR;
    $rep->{$package}{$f_mypid} = $$;
    $rep->{$package}{$f_logfile} = undef;

    bless $rep, $class;
}

sub p_whoami
{
    my $rep = shift;
    $rep->{$package}{$f_whoami};
}

sub p_logpid
{
    my $rep = shift;
    $rep->{$package}{$f_logpid} = $_[0] if @_;
    $rep->{$package}{$f_logpid};
}

sub p_stdout
{
    my $rep = shift;
    $rep->{$package}{$f_stdout};
}

sub p_stderr
{
    my $rep = shift;
    $rep->{$package}{$f_stderr};
}

sub p_parent
{
    my $rep = shift;
    $rep->{$package}{$f_mypid} == $$;
}

sub p_logfile
{
    my $rep = shift;
    $rep->{$package}{$f_logfile} = $_[0] if @_;
    $rep->{$package}{$f_logfile};
}

sub p_kill_logger
{
    my $rep = shift;
    my $logpid = $rep->p_logpid();
    if ($logpid && $rep->p_parent())
    {
	local(*SAVESTDOUT) = $rep->p_stdout();
	local(*SAVESTDERR) = $rep->p_stderr();
	
	close(STDOUT);
	sleep 2;		# try to wait for output to flush
	kill &SIGTERM(), $logpid;
	waitpid($logpid, 0);
	$rep->p_logpid(0);
	open(STDOUT, ">&SAVESTDOUT");
	open(STDERR, ">&SAVESTDERR");
	select(STDOUT);
	$| = 1;
    }
}

sub set_logfile
{
    my $rep = shift;
    my $logfile = (shift || "");

    my $old_logfile = $rep->p_logfile();
    if ((defined $old_logfile) && ($old_logfile eq $logfile))
    {
	return;
    }
    $rep->p_logfile($logfile);

    my $whoami = $rep->p_whoami();
    my $logpid = $rep->p_logpid();

    local(*SAVESTDOUT) = $rep->p_stdout();
    local(*SAVESTDERR) = $rep->p_stderr();

    $rep->p_kill_logger();

    if ($logfile ne "")
    {
	pipe CHILDSTDIN, STDOUT;
	select(STDOUT);
	$| = 1;
	open(STDERR, ">&STDOUT");
	$logpid = fork;
	if (! defined($logpid))
	{
	    open(STDERR, ">&SAVESTDERR");
	    die "$whoami: fork failed\n";
	}

	if ($logpid == 0)
	{
	    open(STDIN, "<&CHILDSTDIN");
	    open(STDOUT, ">&SAVESTDOUT");
	    open(STDERR, ">&SAVESTDERR");
	    select(STDOUT);
	    $| = 1;
	    $0 = "$whoami logger ($logfile)";
	    $rep->timestamp_input_to_file($logfile);
	}
	else
	{
	    close(CHILDSTDIN);
	    $rep->p_logpid($logpid);
	}
    }

    1;
}

sub timestamp_input_to_file
{
    my $rep = shift;
    my $file = shift;

    local(*SAVESTDERR) = $rep->p_stderr();

    my $orin = "";
    vec($orin,fileno(STDIN),1) = 1;
    my $buf = "";
    my $blocksize = 100;
    while (1)
    {
	my $rin = $orin;
	if (select($rin, undef, undef, 30))
	{
	    open(LOG, ">>$file") || open(LOG, ">&SAVESTDERR");
	    select(LOG);
	    $| = 1;

	    my $len = sysread(STDIN, $buf, $blocksize, length($buf));
	    last unless defined $len;
	    while ($buf =~ s/^(.*?)\n//so)
	    {
		print LOG scalar(localtime(time)), ": ", $1, "\n";
	    }
	    select(STDOUT);
	    close(LOG);
	}
	if (getppid() == 1)
	{
	    # This process is now an orphan
	    exit 0;
	}
    }
    exit 0;
}

sub DESTROY
{
    my $rep = shift;
    if ($rep->p_parent())
    {
	$rep->p_kill_logger();
    }
}

sub test
{
    shift;
    my $file = shift;
    {
	my $logger = new Logger($0);
	print "Hello 1.\n";
	$logger->set_logfile($file);
	print "Hello 2.\n";
	$logger->set_logfile(undef);
	print "Hello 3.\n";
	$logger->set_logfile($file);
	print "Hello 4.\n";
    }
    print "Hello 5.\n";
}

1;

#
# END OF Logger
#