Log::Syslog::Abstract - Use any available syslog API

    use Log::Syslog::Abstract qw(openlog syslog closelog);

    openlog( 'myapp', 'pid,ndelay', 'local0' );
    ...
    syslog('info', '%s: %s', 'Something bad happened', $!);
    ...
    closelog();

    perldoc Log::Syslog::Abstract

package Log::Syslog::Abstract;
use warnings;
use strict;
use Carp;

use vars qw( $VERSION @ISA @EXPORT_OK );
$VERSION = '1.200';

require Exporter;
@ISA = qw( Exporter );  ## no critic(ProhibitExplicitISA)

@EXPORT_OK = qw(
	openlog
	syslog
	closelog
);

my $_DETECTED = 0;
sub import
{
	if( ! $_DETECTED ) {

		my ($openlog, $syslog, $closelog);

		# Try Unix::Syslog first, then Sys::Syslog
		eval qq{use Unix::Syslog qw( :macros ); }; ## no critic (StringyEval)
		if( ! $@ ) {  ## no critic (PunctuationVars)
			($openlog, $syslog, $closelog) = _wrap_for_unix_syslog();
		} else {
			eval qq{use Sys::Syslog ();}; ## no critic (StringyEval)
			if( ! $@ ) {  ## no critic (PunctuationVars)
				($openlog, $syslog, $closelog) = _wrap_for_sys_syslog();
			} else {
				croak q{Unable to detect either Unix::Syslog or Sys::Syslog};
			}
		}

		no warnings 'once';  ## no critic (NoWarnings)
		*openlog = $openlog;
		*syslog = $syslog;
		*closelog = $closelog;

		$_DETECTED = 1;
	}

	return __PACKAGE__->export_to_level(1, @_);
}

sub _wrap_for_unix_syslog
{

	my $openlog = sub {
		my ($id, $flags, $facility) = @_;

		## no critic (ProhibitPostfixControls)
		croak q{first argument must be an identifier string} unless defined $id;
		croak q{second argument must be flag string} unless defined $flags;
		croak q{third argument must be a facility string} unless defined $facility;

		my $numeric_flags    = _convert_flags( $flags );
		my $numeric_facility = _convert_facility( $facility );

		return Unix::Syslog::openlog( $id, $numeric_flags, $numeric_facility);
	};

	my $syslog = sub {
		my $facility = shift;
		my $numeric_facility = _convert_facility( $facility );
		return Unix::Syslog::syslog( $numeric_facility, @_);
	};

	my $closelog = \&Unix::Syslog::closelog;

	return ($openlog, $syslog, $closelog);
}

sub _wrap_for_sys_syslog
{

	my $openlog  = sub {
		if( $Sys::Syslog::VERSION < 0.16 ) {
			# Older Sys::Syslog versions still need
			# setlogsock().  RHEL5 still ships with 0.13 :(
			Sys::Syslog::setlogsock([ 'unix', 'tcp', 'udp' ]);
		}
		return Sys::Syslog::openlog(@_);
	};
	my $syslog   = sub {
		return Sys::Syslog::syslog(@_);
	};
	my $closelog = sub {
		return Sys::Syslog::closelog(@_);
	};

	return ($openlog, $syslog, $closelog);
}

{
	my $flag_map;

	sub _convert_flags
	{
		my($flags) = @_;

		if( ! defined $flag_map ) {
			$flag_map = _make_flag_map();
		}

		my $num = 0;
		foreach my $thing (split(/,/, $flags)) {
			if ( ! exists $flag_map->{$thing} ) {
				next;
			}
			$num |= $flag_map->{$thing};
		}
		return $num;
	}

	sub _make_flag_map
	{
		return {
			pid     => Unix::Syslog::LOG_PID(),
			ndelay  => Unix::Syslog::LOG_NDELAY(),
		};
	}
}

{
	my $fac_map;

	sub _convert_facility
	{
		my($facility) = @_;

		if( ! defined $fac_map ) {
			$fac_map = _make_fac_map();
		}

		my $num = 0;
		foreach my $thing (split(/\|/, $facility)) {
			if ( ! exists $fac_map->{$thing} ) {
				next;
			}
			$num |= $fac_map->{$thing};
		}
		return $num;

	}

	my %special = (
		error => 'err',
		panic => 'emerg',
	);

	# Some of the Unix::Syslog 'macros' tag exports aren't
	# constants, so we need to ignore them if found.
	my %blacklisted = map { $_ => 1 } qw(
		LOG_MASK
		LOG_UPTO
		LOG_PRI
		LOG_MAKEPRI
		LOG_FAC
	);

	sub _make_fac_map
	{
		my %map;

		# Ugh.  Make sure we map only the available constants
		# on this platform.  Some are not defined properly on
		# all platforms.
		foreach my $constant ( grep { /^LOG_/ && !exists $blacklisted{$_} } @{ $Unix::Syslog::EXPORT_TAGS{macros}} ) {
			my $name = lc $constant;
			$name =~ s/^log_//;

			my $value = eval "Unix::Syslog::$constant()";
			if( defined $value ) {
				$map{$name} = $value;
			}
		}

		# Some strings supported by Sys::Syslog don't
		# correspond to a Unix::Syslog LOG_XXXX constant.
		while( my($new_key, $existing_key) = each %special ) {
			$map{$new_key} = $map{$existing_key};
		}

		return \%map;
	}
}

1;
__END__