#! /pm/bin/perl5 -w
#
#V  WireSyslog.pm V1.2 20 Mar 1995 (using syslog.ph)
#   WireSyslog.pm V1.0 15 Dec 1994 (for Perl 5.000)
#   Jim Richardson, University of Sydney
#   jimr@maths.usyd.edu.au or http://www.maths.usyd.edu.au:8000/jimr.html

package WireSyslog;

#   This package provides a function syslog for writing messages to syslogd's
#   log analogous to syslog(3), with calling sequence
#
#	syslog( priority_name, message, arguments )
#
#   e.g.
#
#	syslog( ALERT, 'could not open file %s', $filename );
#
#   Options for syslog can be set by calling syslog_options: this is similar
#   in some respects to openlog(3) but with a different calling sequence,
#   namely option-values pairs chosen from the following:
#
#	IDENT => identifying name	default is the program filename
#	PID => 1			log the PID (default is not)
#	NDELAY => 1			contact syslogd immediately, at
#					syslog_options time (default is
#					not to contact until syslog is
#					first called)
#	FACILITY => facility		syslogd facility name: USER, MAIL,
#					DAEMON, etc
#	HOST => syslogd host		default is localhost.
#
#   The connection can be closed with closelog(), and if desired reopened
#   later with different options.
#
#   Unlike syslog(3), wireSyslog::syslog makes no attempt to write to the
#   console if it cannot contact syslogd.  Instead it dies: if desired
#   this can be caught by an eval { } round syslog or syslog_options.


BEGIN
{
    require 'sys/syslog.ph';

    $syslog_port = ( getservbyname( 'syslog', 'udp' ) )[2];

    %facility = (
	USER =>		&LOG_USER,
	MAIL =>		&LOG_MAIL,
	DAEMON =>	&LOG_DAEMON,,
	AUTH =>		&LOG_AUTH,
	LOCAL0 =>	&LOG_LOCAL0,
	LOCAL1 =>	&LOG_LOCAL1,	# add through LOCAL7 if needed
    );

    $facility = $default_facility = $facility{ USER };

    ( $default_ident = $0 ) =~ s!^/?([^/]*/)*!!;
    $ident = $default_ident;

    %priority = (
	EMERG =>	&LOG_EMERG,
	ALERT =>	&LOG_ALERT,
	CRIT =>		&LOG_CRIT,
	ERR =>		&LOG_ERR,
	WARNING	=>	&LOG_WARNING,
	NOTICE =>	&LOG_NOTICE,
	INFO =>		&LOG_INFO,
	DEBUG =>	&LOG_DEBUG,
    );

    $default_prio = &LOG_NOTICE;
}

    use Valparams;
    use Wire;

    require Exporter;
    @ISA = Exporter;
    @EXPORT = qw( syslog_options syslog closelog );

sub syslog_options
{
    $opt = valparams( { @_ }, qw( IDENT PID NDELAY FACILITY HOST ) );

    $ident = $opt->{ IDENT } || $default_ident;

    $pidbr = $opt->{ PID } ? "[$$]" : undef;

    $facility = $facility{ "\U$opt->{ FACILITY }" } || $default_facility;

    &connect if $opt->{ NDELAY };
}

sub connect
{
    return if defined $syslog_wire;

    $syslog_wire = Wire->open(
	UDP => 1,
	HOST => $opt->{ HOST } || 'localhost',
	PORT => $syslog_port,
	TIMEOUT => 20,
	CALLBACK => sub { die "syslog failed: $_[0]\n" } );
}

sub syslog
{
    my ( $prioname, $msg, @params ) = @_;

    my $prio;
    $prio = $default_prio unless defined $prioname &&	# passing undef is quick!
	defined ( $prio = $priority{ $prioname } );

    $msg =~ s/%m/$!/g;	# Replace %m by last error message

    &connect unless defined $syslog_wire;

    $syslog_wire->print( sprintf "<%d>%s%s: $msg", $facility | $prio ,
	$ident, $pidbr, @params );
}

sub closelog
{
    $syslog_wire->close;
    undef $syslog_wire;

    #  Reset defaults in case there's a reopen:

    undef $opt;
    undef $pidbr;
    $facility = $default_facility;
    $ident = $default_ident;
}

#!#
