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 (file)
--- 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 (file)
--- 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 (file)
--- 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'}")