X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FFcntl%2FFcntl.pm;h=067c0612efd8d6a2201386be291021a96a903476;hb=2a5d9b1d41e4bafaa26126c5dea2f6ff0b72b6a7;hp=74de3dfc65df87884e581f9715c5bdeaff950dd0;hpb=69dcf70cb27ded45873eb396cabbcbd82a21a2c8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 74de3df..067c061 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -11,8 +11,8 @@ Fcntl - load the C Fcntl.h defines =head1 DESCRIPTION -This module is just a translation of the C F file. -Unlike the old mechanism of requiring a translated F +This module is just a translation of the C F file. +Unlike the old mechanism of requiring a translated F file, this uses the B program (see the Perl source distribution) and your native C compiler. This means that it has a far more likely chance of getting the numbers right. @@ -37,63 +37,206 @@ 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 to learn about the uses of the O_* constants +with sysopen(). + +See L and L about the SEEK_* constants. + +See L 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); -$VERSION = "1.03"; +use XSLoader (); +@ISA = qw(Exporter); +BEGIN { + $VERSION = "1.05"; +} + # Items to export into callers namespace by default # (move infrequently used names to @EXPORT_OK below) @EXPORT = qw( - F_DUPFD F_GETFD F_GETLK F_SETFD F_GETFL F_SETFL F_SETLK F_SETLKW - FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK F_POSIX - O_CREAT O_EXCL O_NOCTTY O_TRUNC - O_APPEND O_NONBLOCK - O_NDELAY O_DEFER - O_RDONLY O_RDWR O_WRONLY - O_BINARY O_TEXT - O_EXLOCK O_SHLOCK O_ASYNC O_DSYNC O_RSYNC O_SYNC - F_SETOWN F_GETOWN + 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 ); # Other items we are prepared to export if requested @EXPORT_OK = qw( - LOCK_SH LOCK_EX LOCK_NB LOCK_UN - FAPPEND FASYNC FCREAT FDEFER FEXCL FNDELAY FNONBLOCK FSYNC FTRUNC + DN_ACCESS + DN_ATTRIB + DN_CREATE + DN_DELETE + DN_MODIFY + DN_MULTISHOT + DN_RENAME + FAPPEND + FASYNC + FCREAT + FDEFER + FDSYNC + FEXCL + FLARGEFILE + FNDELAY + FNONBLOCK + FRSYNC + FSYNC + FTRUNC + F_GETLEASE + F_GETSIG + F_NOTIFY + F_SETLEASE + F_SETSIG + LOCK_EX + LOCK_MAND + LOCK_NB + LOCK_READ + LOCK_RW + LOCK_SH + LOCK_UN + LOCK_WRITE + O_IGNORE_CTTY + O_NOATIME + O_NOLINK + O_NOTRANS + SEEK_CUR + SEEK_END + SEEK_SET + S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT + S_IREAD S_IWRITE S_IEXEC + S_IRGRP S_IWGRP S_IXGRP S_IRWXG + S_IROTH S_IWOTH S_IXOTH S_IRWXO + S_IRUSR S_IWUSR S_IXUSR S_IRWXU + S_ISUID S_ISGID S_ISVTX S_ISTXT + _S_IFMT S_IFREG S_IFDIR S_IFLNK + &S_ISREG &S_ISDIR &S_ISLNK &S_ISSOCK &S_ISBLK &S_ISCHR &S_ISFIFO + &S_ISWHT &S_ISENFMT &S_IFMT &S_IMODE ); # 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 + )], ); +# Force the constants to become inlined +BEGIN { + XSLoader::load 'Fcntl', $VERSION; +} + +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); - ($constname = $AUTOLOAD) =~ s/.*:://; - my $val = constant($constname, (@_ && (caller(0))[4]) ? $_[0] : 0); - if ($! != 0) { - if ($! =~ /Invalid/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD; - } - else { - my ($pack,$file,$line) = caller; - die "Your vendor has not defined Fcntl macro $constname, used at $file line $line. -"; - } + (my $constname = $AUTOLOAD) =~ s/.*:://; + die "&Fcntl::constant not defined" if $constname eq 'constant'; + my ($error, $val) = constant($constname); + if ($error) { + my (undef,$file,$line) = caller; + die "$error at $file line $line.\n"; } - eval "sub $AUTOLOAD { $val }"; + *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } -bootstrap Fcntl $VERSION; - 1;