From: Roderick Schertler <roderick@gate.net>
Date: Thu, 19 Dec 1996 06:37:17 +0000 (-0500)
Subject: flock() constants
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3dea0e15e4684f6defe2f25a16bc696b96697ac2;p=p5sagit%2Fp5-mst-13.2.git

flock() constants

Could we have the flock() constants in a standard module?  Since we're
supporting flock() via emulation there are lots of systems in which
these constants can't be pulled in via h2ph.

I don't much care where the constants are stored, so long as they're
somewhere.  Here's a patch which just stuffs them in Fcntl.  The @EXPORT
list is the same as before, you have to ask for these constants
explicitly (via ':flock').

p5p-msgid: <26669.850977437@eeyore.ibcinc.com>
---

diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm
index 9d000a1..4898534 100644
--- a/ext/Fcntl/Fcntl.pm
+++ b/ext/Fcntl/Fcntl.pm
@@ -7,6 +7,7 @@ Fcntl - load the C Fcntl.h defines
 =head1 SYNOPSIS
 
     use Fcntl;
+    use Fcntl qw(:DEFAULT :flock);
 
 =head1 DESCRIPTION
 
@@ -21,14 +22,21 @@ far more likely chance of getting the numbers right.
 Only C<#define> symbols get translated; you must still correctly
 pack up your own arguments to pass as args for locking functions, etc.
 
+=head1 EXPORTED SYMBOLS
+
+By default your system's F_* and O_* constants (eg, F_DUPFD and O_CREAT)
+are exported into your namespace.  You can request that the flock()
+constants (LOCK_SH, LOCK_EX, LOCK_NB and LOCK_UN) be provided by using
+the tag C<:flock>.  See L<Exporter>.
+
 =cut
 
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
 
 require Exporter;
 require DynaLoader;
 @ISA = qw(Exporter DynaLoader);
-$VERSION = "1.00";
+$VERSION = "1.01";
 # Items to export into callers namespace by default
 # (move infrequently used names to @EXPORT_OK below)
 @EXPORT =
@@ -42,6 +50,11 @@ $VERSION = "1.00";
      );
 # Other items we are prepared to export if requested
 @EXPORT_OK = qw(
+    LOCK_SH LOCK_EX LOCK_NB LOCK_UN
+);
+# Named groups of exports
+%EXPORT_TAGS = (
+    'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)],
 );
 
 sub AUTOLOAD {
diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs
index 90f3af5..0f51b10 100644
--- a/ext/Fcntl/Fcntl.xs
+++ b/ext/Fcntl/Fcntl.xs
@@ -115,6 +115,37 @@ int arg;
 	    goto not_there;
 #endif
 	break;
+    case 'L':
+    	if (strnEQ(name, "LOCK_", 5)) {
+	    /* We support flock() on systems which don't have it, so
+	       always supply the constants. */
+	    if (strEQ(name, "LOCK_SH"))
+#ifdef LOCK_SH
+		return LOCK_SH;
+#else
+		return 1;
+#endif
+	    if (strEQ(name, "LOCK_EX"))
+#ifdef LOCK_EX
+		return LOCK_EX;
+#else
+		return 2;
+#endif
+    	    if (strEQ(name, "LOCK_NB"))
+#ifdef LOCK_NB
+		return LOCK_NB;
+#else
+		return 4;
+#endif
+    	    if (strEQ(name, "LOCK_UN"))
+#ifdef LOCK_UN
+    	    	return LOCK_UN;
+#else
+    	    	return 8;
+#endif
+	} else
+	  goto not_there;
+    	break;
     case 'O':
 	if (strnEQ(name, "O_", 2)) {
 	    if (strEQ(name, "O_CREAT"))
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 1148176..58d1100 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1040,20 +1040,17 @@ would need to use the more system-specific fcntl() for that.
 
 Here's a mailbox appender for BSD systems.
 
-    $LOCK_SH = 1;
-    $LOCK_EX = 2;
-    $LOCK_NB = 4;
-    $LOCK_UN = 8;
+    use Fcntl ':flock'; # import LOCK_* constants
 
     sub lock {
-	flock(MBOX,$LOCK_EX);
+	flock(MBOX,LOCK_EX);
 	# and, in case someone appended
 	# while we were waiting...
 	seek(MBOX, 0, 2);
     }
 
     sub unlock {
-	flock(MBOX,$LOCK_UN);
+	flock(MBOX,LOCK_UN);
     }
 
     open(MBOX, ">>/usr/spool/mail/$ENV{'USER'}")