From: Gurusamy Sarathy <gsar@cpan.org>
Date: Fri, 4 Feb 2000 07:29:59 +0000 (+0000)
Subject: Sys::Syslog goes the XS way (from Tom Hughes <tom@compton.nu>)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8ce86de80c578becb41c7a7cb2635339f1d83b39;p=p5sagit%2Fp5-mst-13.2.git

Sys::Syslog goes the XS way (from Tom Hughes <tom@compton.nu>)

p4raw-id: //depot/perl@4980
---

diff --git a/MANIFEST b/MANIFEST
index 938a0c0..4753599 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -364,6 +364,9 @@ ext/SDBM_File/typemap		SDBM extension interface types
 ext/Socket/Makefile.PL	Socket extension makefile writer
 ext/Socket/Socket.pm	Socket extension Perl module
 ext/Socket/Socket.xs	Socket extension external subroutines
+ext/Sys/Syslog/Makefile.PL	Sys::Syslog extension makefile writer
+ext/Sys/Syslog/Syslog.pm	Sys::Syslog extension Perl module
+ext/Sys/Syslog/Syslog.xs	Sys::Syslog extension external subroutines
 ext/Thread/Makefile.PL	Thread extension makefile writer
 ext/Thread/Notes	Thread notes
 ext/Thread/README	Thread README
@@ -644,7 +647,6 @@ lib/SelfLoader.pm	Load functions only on demand
 lib/Shell.pm		Make AUTOLOADed system() calls
 lib/Symbol.pm		Symbol table manipulation routines
 lib/Sys/Hostname.pm	Hostname methods
-lib/Sys/Syslog.pm	Perl module supporting syslogging
 lib/Term/Cap.pm		Perl module supporting termcap usage
 lib/Term/Complete.pm	A command completion subroutine
 lib/Term/ReadLine.pm	Stub readline library
diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL
new file mode 100644
index 0000000..253130a
--- /dev/null
+++ b/ext/Sys/Syslog/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME		=> 'Sys::Syslog',
+    VERSION_FROM	=> 'Syslog.pm', 
+    XSPROTOARG          => '-noprototypes',
+);
diff --git a/lib/Sys/Syslog.pm b/ext/Sys/Syslog/Syslog.pm
similarity index 90%
rename from lib/Sys/Syslog.pm
rename to ext/Sys/Syslog/Syslog.pm
index f0cbb71..b447374 100644
--- a/lib/Sys/Syslog.pm
+++ b/ext/Sys/Syslog/Syslog.pm
@@ -1,11 +1,13 @@
 package Sys::Syslog;
 require 5.000;
 require Exporter;
+require DynaLoader;
 use Carp;
 
-@ISA = qw(Exporter);
+@ISA = qw(Exporter DynaLoader);
 @EXPORT = qw(openlog closelog setlogmask syslog);
 @EXPORT_OK = qw(setlogsock);
+$VERSION = '0.01';
 
 use Socket;
 use Sys::Hostname;
@@ -17,6 +19,7 @@ use Sys::Hostname;
 # NOTE: openlog now takes three arguments, just like openlog(3)
 # Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
 #  with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
+# Modified to use an XS backend instead of syslog.ph by Tom Hughes <tom@compton.nu>
 
 # Todo: enable connect to try all three types before failing (auto setlogsock)?
 
@@ -98,10 +101,6 @@ Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
     $! = 55;
     syslog('info', 'problem was %m'); # %m == $! in syslog(3)
 
-=head1 DEPENDENCIES
-
-B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
-
 =head1 SEE ALSO
 
 L<syslog(3)>
@@ -111,10 +110,27 @@ L<syslog(3)>
 Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
 UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
 with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
+Dependency on F<syslog.ph> replaced with XS code bu Tom Hughes E<lt>F<tom@compton.nu>E<gt>.
 
 =cut
 
-require 'syslog.ph';
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.
+
+    my $constname;
+    our $AUTOLOAD;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    croak "& not defined" if $constname eq 'constant';
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	croak "Your vendor has not defined Sys::Syslog macro $constname";
+    }
+    *$AUTOLOAD = sub { $val };
+    goto &$AUTOLOAD;
+}
+
+bootstrap Sys::Syslog $VERSION;
 
 $maskpri = &LOG_UPTO(&LOG_DEBUG);
 
@@ -240,7 +256,7 @@ sub xlate {
     $name = uc $name;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "Sys::Syslog::$name";
-    defined &$name ? &$name : -1;
+    eval { &$name } || -1;
 }
 
 sub connect {
diff --git a/ext/Sys/Syslog/Syslog.xs b/ext/Sys/Syslog/Syslog.xs
new file mode 100644
index 0000000..ac5220c
--- /dev/null
+++ b/ext/Sys/Syslog/Syslog.xs
@@ -0,0 +1,635 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <sys/syslog.h>
+
+static double
+constant_LOG_NO(char *name, int len, int arg)
+{
+    switch (name[6 + 0]) {
+    case 'T':
+	if (strEQ(name + 6, "TICE")) {	/* LOG_NO removed */
+#ifdef LOG_NOTICE
+	    return LOG_NOTICE;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'W':
+	if (strEQ(name + 6, "WAIT")) {	/* LOG_NO removed */
+#ifdef LOG_NOWAIT
+	    return LOG_NOWAIT;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_N(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'D':
+	if (strEQ(name + 5, "DELAY")) {	/* LOG_N removed */
+#ifdef LOG_NDELAY
+	    return LOG_NDELAY;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'E':
+	if (strEQ(name + 5, "EWS")) {	/* LOG_N removed */
+#ifdef LOG_NEWS
+	    return LOG_NEWS;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'F':
+	if (strEQ(name + 5, "FACILITIES")) {	/* LOG_N removed */
+#ifdef LOG_NFACILITIES
+	    return LOG_NFACILITIES;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'O':
+	return constant_LOG_NO(name, len, arg);
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_P(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'I':
+	if (strEQ(name + 5, "ID")) {	/* LOG_P removed */
+#ifdef LOG_PID
+	    return LOG_PID;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'R':
+	if (strEQ(name + 5, "RIMASK")) {	/* LOG_P removed */
+#ifdef LOG_PRIMASK
+	    return LOG_PRIMASK;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_AU(char *name, int len, int arg)
+{
+    if (6 + 2 >= len ) {
+	errno = EINVAL;
+	return 0;
+    }
+    switch (name[6 + 2]) {
+    case '\0':
+	if (strEQ(name + 6, "TH")) {	/* LOG_AU removed */
+#ifdef LOG_AUTH
+	    return LOG_AUTH;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'P':
+	if (strEQ(name + 6, "THPRIV")) {	/* LOG_AU removed */
+#ifdef LOG_AUTHPRIV
+	    return LOG_AUTHPRIV;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_A(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'L':
+	if (strEQ(name + 5, "LERT")) {	/* LOG_A removed */
+#ifdef LOG_ALERT
+	    return LOG_ALERT;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'U':
+	return constant_LOG_AU(name, len, arg);
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_CR(char *name, int len, int arg)
+{
+    switch (name[6 + 0]) {
+    case 'I':
+	if (strEQ(name + 6, "IT")) {	/* LOG_CR removed */
+#ifdef LOG_CRIT
+	    return LOG_CRIT;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'O':
+	if (strEQ(name + 6, "ON")) {	/* LOG_CR removed */
+#ifdef LOG_CRON
+	    return LOG_CRON;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_C(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'O':
+	if (strEQ(name + 5, "ONS")) {	/* LOG_C removed */
+#ifdef LOG_CONS
+	    return LOG_CONS;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'R':
+	return constant_LOG_CR(name, len, arg);
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_D(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'A':
+	if (strEQ(name + 5, "AEMON")) {	/* LOG_D removed */
+#ifdef LOG_DAEMON
+	    return LOG_DAEMON;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'E':
+	if (strEQ(name + 5, "EBUG")) {	/* LOG_D removed */
+#ifdef LOG_DEBUG
+	    return LOG_DEBUG;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_U(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'S':
+	if (strEQ(name + 5, "SER")) {	/* LOG_U removed */
+#ifdef LOG_USER
+	    return LOG_USER;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'U':
+	if (strEQ(name + 5, "UCP")) {	/* LOG_U removed */
+#ifdef LOG_UUCP
+	    return LOG_UUCP;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_E(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'M':
+	if (strEQ(name + 5, "MERG")) {	/* LOG_E removed */
+#ifdef LOG_EMERG
+	    return LOG_EMERG;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'R':
+	if (strEQ(name + 5, "RR")) {	/* LOG_E removed */
+#ifdef LOG_ERR
+	    return LOG_ERR;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_F(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'A':
+	if (strEQ(name + 5, "ACMASK")) {	/* LOG_F removed */
+#ifdef LOG_FACMASK
+	    return LOG_FACMASK;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'T':
+	if (strEQ(name + 5, "TP")) {	/* LOG_F removed */
+#ifdef LOG_FTP
+	    return LOG_FTP;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_LO(char *name, int len, int arg)
+{
+    if (6 + 3 >= len ) {
+	errno = EINVAL;
+	return 0;
+    }
+    switch (name[6 + 3]) {
+    case '0':
+	if (strEQ(name + 6, "CAL0")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL0
+	    return LOG_LOCAL0;
+#else
+	    goto not_there;
+#endif
+	}
+    case '1':
+	if (strEQ(name + 6, "CAL1")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL1
+	    return LOG_LOCAL1;
+#else
+	    goto not_there;
+#endif
+	}
+    case '2':
+	if (strEQ(name + 6, "CAL2")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL2
+	    return LOG_LOCAL2;
+#else
+	    goto not_there;
+#endif
+	}
+    case '3':
+	if (strEQ(name + 6, "CAL3")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL3
+	    return LOG_LOCAL3;
+#else
+	    goto not_there;
+#endif
+	}
+    case '4':
+	if (strEQ(name + 6, "CAL4")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL4
+	    return LOG_LOCAL4;
+#else
+	    goto not_there;
+#endif
+	}
+    case '5':
+	if (strEQ(name + 6, "CAL5")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL5
+	    return LOG_LOCAL5;
+#else
+	    goto not_there;
+#endif
+	}
+    case '6':
+	if (strEQ(name + 6, "CAL6")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL6
+	    return LOG_LOCAL6;
+#else
+	    goto not_there;
+#endif
+	}
+    case '7':
+	if (strEQ(name + 6, "CAL7")) {	/* LOG_LO removed */
+#ifdef LOG_LOCAL7
+	    return LOG_LOCAL7;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant_LOG_L(char *name, int len, int arg)
+{
+    switch (name[5 + 0]) {
+    case 'F':
+	if (strEQ(name + 5, "FMT")) {	/* LOG_L removed */
+#ifdef LOG_LFMT
+	    return LOG_LFMT;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'O':
+	return constant_LOG_LO(name, len, arg);
+    case 'P':
+	if (strEQ(name + 5, "PR")) {	/* LOG_L removed */
+#ifdef LOG_LPR
+	    return LOG_LPR;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+static double
+constant(char *name, int len, int arg)
+{
+    errno = 0;
+    if (0 + 4 >= len ) {
+	errno = EINVAL;
+	return 0;
+    }
+    switch (name[0 + 4]) {
+    case 'A':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_A(name, len, arg);
+    case 'C':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_C(name, len, arg);
+    case 'D':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_D(name, len, arg);
+    case 'E':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_E(name, len, arg);
+    case 'F':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_F(name, len, arg);
+    case 'I':
+	if (strEQ(name + 0, "LOG_INFO")) {	/*  removed */
+#ifdef LOG_INFO
+	    return LOG_INFO;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'K':
+	if (strEQ(name + 0, "LOG_KERN")) {	/*  removed */
+#ifdef LOG_KERN
+	    return LOG_KERN;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'L':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_L(name, len, arg);
+    case 'M':
+	if (strEQ(name + 0, "LOG_MAIL")) {	/*  removed */
+#ifdef LOG_MAIL
+	    return LOG_MAIL;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'N':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_N(name, len, arg);
+    case 'O':
+	if (strEQ(name + 0, "LOG_ODELAY")) {	/*  removed */
+#ifdef LOG_ODELAY
+	    return LOG_ODELAY;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'P':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_P(name, len, arg);
+    case 'S':
+	if (strEQ(name + 0, "LOG_SYSLOG")) {	/*  removed */
+#ifdef LOG_SYSLOG
+	    return LOG_SYSLOG;
+#else
+	    goto not_there;
+#endif
+	}
+    case 'U':
+	if (!strnEQ(name + 0,"LOG_", 4))
+	    break;
+	return constant_LOG_U(name, len, arg);
+    case 'W':
+	if (strEQ(name + 0, "LOG_WARNING")) {	/*  removed */
+#ifdef LOG_WARNING
+	    return LOG_WARNING;
+#else
+	    goto not_there;
+#endif
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+
+MODULE = Sys::Syslog		PACKAGE = Sys::Syslog		
+
+char *
+_PATH_LOG()
+    CODE:
+#ifdef _PATH_LOG
+	RETVAL = _PATH_LOG;
+#else
+	croak("Your vendor has not defined the Sys::Syslog macro _PATH_LOG");
+#endif
+    OUTPUT:
+	RETVAL
+
+int
+LOG_FAC(p)
+    INPUT:
+	int		p
+    CODE:
+#ifdef LOG_FAC
+	RETVAL = LOG_FAC(p);
+#else
+	croak("Your vendor has not defined the Sys::Syslog macro LOG_FAC");
+#endif
+    OUTPUT:
+	RETVAL
+
+int
+LOG_PRI(p)
+    INPUT:
+	int		p
+    CODE:
+#ifdef LOG_PRI
+	RETVAL = LOG_PRI(p);
+#else
+	croak("Your vendor has not defined the Sys::Syslog macro LOG_PRI");
+#endif
+    OUTPUT:
+	RETVAL
+
+int
+LOG_MAKEPRI(fac,pri)
+    INPUT:
+	int		fac
+	int		pri
+    CODE:
+#ifdef LOG_MAKEPRI
+	RETVAL = LOG_MAKEPRI(fac,pri);
+#else
+	croak("Your vendor has not defined the Sys::Syslog macro LOG_MAKEPRI");
+#endif
+    OUTPUT:
+	RETVAL
+
+int
+LOG_MASK(pri)
+    INPUT:
+	int		pri
+    CODE:
+#ifdef LOG_MASK
+	RETVAL = LOG_MASK(pri);
+#else
+	croak("Your vendor has not defined the Sys::Syslog macro LOG_MASK");
+#endif
+    OUTPUT:
+	RETVAL
+
+int
+LOG_UPTO(pri)
+    INPUT:
+	int		pri
+    CODE:
+#ifdef LOG_UPTO
+	RETVAL = LOG_UPTO(pri);
+#else
+	croak("Your vendor has not defined the Sys::Syslog macro LOG_UPTO");
+#endif
+    OUTPUT:
+	RETVAL
+
+
+double
+constant(sv,arg)
+    PREINIT:
+	STRLEN		len;
+    INPUT:
+	SV *		sv
+	char *		s = SvPV(sv, len);
+	int		arg
+    CODE:
+	RETVAL = constant(s,len,arg);
+    OUTPUT:
+	RETVAL
+
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 50721c3..a22f75b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1638,6 +1638,11 @@ A bug that may have caused data loss when more than one disk block
 happens to be read from the database in a single FETCH() has been
 fixed.
 
+=item Sys::Syslog
+
+Sys::Syslog now uses XSUBs to access facilities from syslog.h so it
+no longer requires syslog.ph to exist. 
+
 =item Time::Local
 
 The timelocal() and timegm() functions used to silently return bogus