Vendor import of Perl 5.006

2 files changed, 504 insertions, 9 deletions

diff --git a/contrib/perl5/ext/Fcntl/Fcntl.pm b/contrib/perl5/ext/Fcntl/Fcntl.pm
index f1edb8e..92103a1 100644
--- a/contrib/perl5/ext/Fcntl/Fcntl.pm
+++ b/contrib/perl5/ext/Fcntl/Fcntl.pm
@@ -37,55 +37,99 @@ applications the newer versions of these constants are suggested
 (O_APPEND, O_ASYNC, O_CREAT, O_DEFER, O_EXCL, O_NDELAY, O_NONBLOCK,
 O_SYNC, O_TRUNC).
 
-Please refer to your native fcntl() and open() documentation to see
-what constants are implemented in your system.
+For ease of use also the SEEK_* constants (for seek() and sysseek(),
+e.g. SEEK_END) and the S_I* constants (for chmod() and stat()) are
+available for import.  They can be imported either separately or using
+the tags C<:seek> and C<:mode>.
+
+Please refer to your native fcntl(2), open(2), fseek(3), lseek(2)
+(equal to Perl's seek() and sysseek(), respectively), and chmod(2)
+documentation to see what constants are implemented in your system.
+
+See L<perlopentut> to learn about the uses of the O_* constants
+with sysopen().
+
+See L<perlfunc/seek> and L<perlfunc/sysseek> about the SEEK_* constants.
+
+See L<perlfunc/stat> about the S_I* constants.
 
 =cut
 
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $AUTOLOAD);
 
 require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Exporter);
 $VERSION = "1.03";
 # Items to export into callers namespace by default
 # (move infrequently used names to @EXPORT_OK below)
 @EXPORT =
   qw(
 	FD_CLOEXEC
+	F_ALLOCSP
+	F_ALLOCSP64
+	F_COMPAT
+	F_DUP2FD
 	F_DUPFD
 	F_EXLCK
+	F_FREESP
+	F_FREESP64
+	F_FSYNC
+	F_FSYNC64
 	F_GETFD
 	F_GETFL
 	F_GETLK
+	F_GETLK64
 	F_GETOWN
+	F_NODNY
 	F_POSIX
+	F_RDACC
+	F_RDDNY
 	F_RDLCK
+	F_RWACC
+	F_RWDNY
 	F_SETFD
 	F_SETFL
 	F_SETLK
+	F_SETLK64
 	F_SETLKW
+	F_SETLKW64
 	F_SETOWN
+	F_SHARE
 	F_SHLCK
 	F_UNLCK
+	F_UNSHARE
+	F_WRACC
+	F_WRDNY
 	F_WRLCK
 	O_ACCMODE
+	O_ALIAS
 	O_APPEND
 	O_ASYNC
 	O_BINARY
 	O_CREAT
 	O_DEFER
+	O_DIRECT
+	O_DIRECTORY
 	O_DSYNC
 	O_EXCL
 	O_EXLOCK
+	O_LARGEFILE
 	O_NDELAY
 	O_NOCTTY
+	O_NOFOLLOW
+	O_NOINHERIT
 	O_NONBLOCK
+	O_RANDOM
+	O_RAW
 	O_RDONLY
 	O_RDWR
+	O_RSRC
 	O_RSYNC
+	O_SEQUENTIAL
 	O_SHLOCK
 	O_SYNC
+	O_TEMPORARY
 	O_TEXT
 	O_TRUNC
 	O_WRONLY
@@ -97,28 +141,69 @@ $VERSION = "1.03";
 	FASYNC
 	FCREAT
 	FDEFER
+	FDSYNC
 	FEXCL
+	FLARGEFILE
 	FNDELAY
 	FNONBLOCK
+	FRSYNC
 	FSYNC
 	FTRUNC
 	LOCK_EX
 	LOCK_NB
 	LOCK_SH
 	LOCK_UN
+	S_ISUID S_ISGID S_ISVTX S_ISTXT
+	_S_IFMT S_IFREG S_IFDIR S_IFLNK
+	S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT
+	S_IRUSR S_IWUSR S_IXUSR S_IRWXU
+	S_IRGRP S_IWGRP S_IXGRP S_IRWXG
+	S_IROTH S_IWOTH S_IXOTH S_IRWXO
+	S_IREAD S_IWRITE S_IEXEC
+	&S_ISREG &S_ISDIR &S_ISLNK &S_ISSOCK &S_ISBLK &S_ISCHR &S_ISFIFO
+	&S_ISWHT &S_ISENFMT &S_IFMT &S_IMODE
+	SEEK_SET
+	SEEK_CUR
+	SEEK_END
 );
 # Named groups of exports
 %EXPORT_TAGS = (
     'flock'   => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)],
-    'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FEXCL
-	             FNDELAY FNONBLOCK FSYNC FTRUNC)],
+    'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FEXCL FLARGEFILE
+		     FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC)],
+    'seek'    => [qw(SEEK_SET SEEK_CUR SEEK_END)],
+    'mode'    => [qw(S_ISUID S_ISGID S_ISVTX S_ISTXT
+		     _S_IFMT S_IFREG S_IFDIR S_IFLNK
+		     S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT
+		     S_IRUSR S_IWUSR S_IXUSR S_IRWXU
+		     S_IRGRP S_IWGRP S_IXGRP S_IRWXG
+		     S_IROTH S_IWOTH S_IXOTH S_IRWXO
+		     S_IREAD S_IWRITE S_IEXEC
+		     S_ISREG S_ISDIR S_ISLNK S_ISSOCK
+		     S_ISBLK S_ISCHR S_ISFIFO
+		     S_ISWHT S_ISENFMT		
+		     S_IFMT S_IMODE
+                  )],
 );
 
+sub S_IFMT  { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT()  }
+sub S_IMODE { $_[0] & 07777 }
+
+sub S_ISREG    { ( $_[0] & _S_IFMT() ) == S_IFREG()   }
+sub S_ISDIR    { ( $_[0] & _S_IFMT() ) == S_IFDIR()   }
+sub S_ISLNK    { ( $_[0] & _S_IFMT() ) == S_IFLNK()   }
+sub S_ISSOCK   { ( $_[0] & _S_IFMT() ) == S_IFSOCK()  }
+sub S_ISBLK    { ( $_[0] & _S_IFMT() ) == S_IFBLK()   }
+sub S_ISCHR    { ( $_[0] & _S_IFMT() ) == S_IFCHR()   }
+sub S_ISFIFO   { ( $_[0] & _S_IFMT() ) == S_IFIFO()   }
+sub S_ISWHT    { ( $_[0] & _S_IFMT() ) == S_IFWHT()   }
+sub S_ISENFMT  { ( $_[0] & _S_IFMT() ) == S_IFENFMT() }
+
 sub AUTOLOAD {
     (my $constname = $AUTOLOAD) =~ s/.*:://;
     my $val = constant($constname, 0);
     if ($! != 0) {
-	if ($! =~ /Invalid/) {
+	if ($! =~ /Invalid/ || $!{EINVAL}) {
 	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
 	    goto &AutoLoader::AUTOLOAD;
 	}
@@ -132,6 +217,6 @@ sub AUTOLOAD {
     goto &$AUTOLOAD;
 }
 
-bootstrap Fcntl $VERSION;
+XSLoader::load 'Fcntl', $VERSION;
 
 1;
diff --git a/contrib/perl5/ext/Fcntl/Fcntl.xs b/contrib/perl5/ext/Fcntl/Fcntl.xs
index 5149444..b597e03 100644
--- a/contrib/perl5/ext/Fcntl/Fcntl.xs
+++ b/contrib/perl5/ext/Fcntl/Fcntl.xs
@@ -1,3 +1,4 @@
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -14,6 +15,10 @@
 #endif 
 #endif
 
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
 /* This comment is a kludge to get metaconfig to see the symbols
     VAL_O_NONBLOCK
     VAL_EAGAIN
@@ -40,8 +45,40 @@ constant(char *name, int arg)
 {
     errno = 0;
     switch (*name) {
+    case '_':
+	if (strEQ(name, "_S_IFMT")) /* Yes, on name _S_IFMT return S_IFMT. */
+#ifdef S_IFMT
+	  return S_IFMT;
+#else
+	  goto not_there;
+#endif
+	break;
     case 'F':
 	if (strnEQ(name, "F_", 2)) {
+	    if (strEQ(name, "F_ALLOCSP"))
+#ifdef F_ALLOCSP
+	        return F_ALLOCSP;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_ALLOCSP64"))
+#ifdef F_ALLOCSP64
+	        return F_ALLOCSP64;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_COMPAT"))
+#ifdef F_COMPAT
+	        return F_COMPAT;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_DUP2FD"))
+#ifdef F_DUP2FD
+	        return F_DUP2FD;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_DUPFD"))
 #ifdef F_DUPFD
 	        return F_DUPFD;
@@ -54,6 +91,30 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_FREESP"))
+#ifdef F_FREESP
+	        return F_FREESP;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_FREESP64"))
+#ifdef F_FREESP64
+	        return F_FREESP64;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_FSYNC"))
+#ifdef F_FSYNC
+	        return F_FSYNC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_FSYNC64"))
+#ifdef F_FSYNC64
+	        return F_FSYNC64;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_GETFD"))
 #ifdef F_GETFD
 	        return F_GETFD;
@@ -72,24 +133,60 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_GETLK64"))
+#ifdef F_GETLK64
+	        return F_GETLK64;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_GETOWN"))
 #ifdef F_GETOWN
 	        return F_GETOWN;
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_NODNY"))
+#ifdef F_NODNY
+	        return F_NODNY;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_POSIX"))
 #ifdef F_POSIX
 	        return F_POSIX;
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_RDACC"))
+#ifdef F_RDACC
+	        return F_RDACC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_RDDNY"))
+#ifdef F_RDDNY
+	        return F_RDDNY;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_RDLCK"))
 #ifdef F_RDLCK
 	        return F_RDLCK;
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_RWACC"))
+#ifdef F_RWACC
+	        return F_RWACC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_RWDNY"))
+#ifdef F_RWDNY
+	        return F_RWDNY;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_SETFD"))
 #ifdef F_SETFD
 	        return F_SETFD;
@@ -108,18 +205,36 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_SETLK64"))
+#ifdef F_SETLK64
+	        return F_SETLK64;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_SETLKW"))
 #ifdef F_SETLKW
 	        return F_SETLKW;
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_SETLKW64"))
+#ifdef F_SETLKW64
+	        return F_SETLKW64;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_SETOWN"))
 #ifdef F_SETOWN
 	        return F_SETOWN;
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_SHARE"))
+#ifdef F_SHARE
+	        return F_SHARE;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_SHLCK"))
 #ifdef F_SHLCK
 	        return F_SHLCK;
@@ -132,6 +247,24 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "F_UNSHARE"))
+#ifdef F_UNSHARE
+	        return F_UNSHARE;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_WRACC"))
+#ifdef F_WRACC
+	        return F_WRACC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_WRDNY"))
+#ifdef F_WRDNY
+	        return F_WRDNY;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "F_WRLCK"))
 #ifdef F_WRLCK
 	        return F_WRLCK;
@@ -171,12 +304,24 @@ constant(char *name, int arg)
 #else
 	    goto not_there;
 #endif
+        if (strEQ(name, "FDSYNC"))
+#ifdef FDSYNC
+            return FDSYNC;
+#else
+            goto not_there;
+#endif
         if (strEQ(name, "FEXCL"))
 #ifdef FEXCL
             return FEXCL;
 #else
             goto not_there;
 #endif
+        if (strEQ(name, "FLARGEFILE"))
+#ifdef FLARGEFILE
+            return FLARGEFILE;
+#else
+            goto not_there;
+#endif
         if (strEQ(name, "FNDELAY"))
 #ifdef FNDELAY
             return FNDELAY;
@@ -189,6 +334,12 @@ constant(char *name, int arg)
 #else
             goto not_there;
 #endif
+        if (strEQ(name, "FRSYNC"))
+#ifdef FRSYNC
+            return FRSYNC;
+#else
+            goto not_there;
+#endif
         if (strEQ(name, "FSYNC"))
 #ifdef FSYNC
             return FSYNC;
@@ -271,6 +422,18 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_DIRECT"))
+#ifdef O_DIRECT
+	        return O_DIRECT;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_DIRECTORY"))
+#ifdef O_DIRECTORY
+	        return O_DIRECTORY;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "O_DSYNC"))
 #ifdef O_DSYNC
 	        return O_DSYNC;
@@ -289,6 +452,12 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_LARGEFILE"))
+#ifdef O_LARGEFILE
+	        return O_LARGEFILE;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "O_NDELAY"))
 #ifdef O_NDELAY
 	        return O_NDELAY;
@@ -301,12 +470,36 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_NOFOLLOW"))
+#ifdef O_NOFOLLOW
+	        return O_NOFOLLOW;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_NOINHERIT"))
+#ifdef O_NOINHERIT
+	        return O_NOINHERIT;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "O_NONBLOCK"))
 #ifdef O_NONBLOCK
 	        return O_NONBLOCK;
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_RANDOM"))
+#ifdef O_RANDOM
+	        return O_RANDOM;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_RAW"))
+#ifdef O_RAW
+	        return O_RAW;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "O_RDONLY"))
 #ifdef O_RDONLY
 	        return O_RDONLY;
@@ -325,6 +518,12 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_SEQUENTIAL"))
+#ifdef O_SEQUENTIAL
+	        return O_SEQUENTIAL;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "O_SHLOCK"))
 #ifdef O_SHLOCK
 	        return O_SHLOCK;
@@ -337,6 +536,12 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_TEMPORARY"))
+#ifdef O_TEMPORARY
+	        return O_TEMPORARY;
+#else
+	        goto not_there;
+#endif
 	    if (strEQ(name, "O_TEXT"))
 #ifdef O_TEXT
 	        return O_TEXT;
@@ -355,9 +560,214 @@ constant(char *name, int arg)
 #else
 	        goto not_there;
 #endif
+	    if (strEQ(name, "O_ALIAS"))
+#ifdef O_ALIAS
+	        return O_ALIAS;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_RSRC"))
+#ifdef O_RSRC
+	        return O_RSRC;
+#else
+	        goto not_there;
+#endif
 	} else
 	  goto not_there;
 	break;
+    case 'S':
+      switch (name[1]) {
+      case '_':
+	if (strEQ(name, "S_ISUID"))
+#ifdef S_ISUID
+	  return S_ISUID;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_ISGID"))
+#ifdef S_ISGID
+	  return S_ISGID;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_ISVTX"))
+#ifdef S_ISVTX
+	  return S_ISVTX;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_ISTXT"))
+#ifdef S_ISTXT
+	  return S_ISTXT;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFREG"))
+#ifdef S_IFREG
+	  return S_IFREG;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFDIR"))
+#ifdef S_IFDIR
+	  return S_IFDIR;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFLNK"))
+#ifdef S_IFLNK
+	  return S_IFLNK;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFSOCK"))
+#ifdef S_IFSOCK
+	  return S_IFSOCK;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFBLK"))
+#ifdef S_IFBLK
+	  return S_IFBLK;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFCHR"))
+#ifdef S_IFCHR
+	  return S_IFCHR;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFIFO"))
+#ifdef S_IFIFO
+	  return S_IFIFO;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IFWHT"))
+#ifdef S_IFWHT
+	  return S_IFWHT;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_ENFMT"))
+#ifdef S_ENFMT
+	  return S_ENFMT;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IRUSR"))
+#ifdef S_IRUSR
+	  return S_IRUSR;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IWUSR"))
+#ifdef S_IWUSR
+	  return S_IWUSR;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IXUSR"))
+#ifdef S_IXUSR
+	  return S_IXUSR;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IRWXU"))
+#ifdef S_IRWXU
+	  return S_IRWXU;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IRGRP"))
+#ifdef S_IRGRP
+	  return S_IRGRP;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IWGRP"))
+#ifdef S_IWGRP
+	  return S_IWGRP;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IXGRP"))
+#ifdef S_IXGRP
+	  return S_IXGRP;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IRWXG"))
+#ifdef S_IRWXG
+	  return S_IRWXG;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IROTH"))
+#ifdef S_IROTH
+	  return S_IROTH;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IWOTH"))
+#ifdef S_IWOTH
+	  return S_IWOTH;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IXOTH"))
+#ifdef S_IXOTH
+	  return S_IXOTH;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IRWXO"))
+#ifdef S_IRWXO
+	  return S_IRWXO;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IREAD"))
+#ifdef S_IREAD
+	  return S_IREAD;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IWRITE"))
+#ifdef S_IWRITE
+	  return S_IWRITE;
+#else
+	  goto not_there;
+#endif
+	if (strEQ(name, "S_IEXEC"))
+#ifdef S_IEXEC
+	  return S_IEXEC;
+#else
+	  goto not_there;
+#endif
+	break;
+      case 'E':
+	  if (strEQ(name, "SEEK_CUR"))
+#ifdef SEEK_CUR
+	    return SEEK_CUR;
+#else
+	    return 1;
+#endif
+	if (strEQ(name, "SEEK_END"))
+#ifdef SEEK_END
+	    return SEEK_END;
+#else
+	    return 2;
+#endif
+	if (strEQ(name, "SEEK_SET"))
+#ifdef SEEK_SET
+	    return SEEK_SET;
+#else
+	    return 0;
+#endif
+	break;
+      }    
     }
     errno = EINVAL;
     return 0;