X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.pm;h=120769c6232c4b93293428bdfb164898f48f15e7;hb=e27b5b51275a893e82bce85334679ee38d3d6bf8;hp=2ec44f88462c05cf08c4267211d3e2a59cce1278;hpb=1dfe7606714789cb685cd524877388fe1e9008b4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm
index 2ec44f8..120769c 100644
--- a/ext/POSIX/POSIX.pm
+++ b/ext/POSIX/POSIX.pm
@@ -1,12 +1,22 @@
 package POSIX;
+use strict;
+use warnings;
 
-our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD) = ();
+our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
+
+our $VERSION = "1.17";
 
 use AutoLoader;
 
 use XSLoader ();
 
-our $VERSION = "1.04" ;
+use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
+	     F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
+	     O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
+	     O_WRONLY SEEK_CUR SEEK_END SEEK_SET
+	     S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
+	     S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
+	     S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
 
 # Grandfather old foo_h form to new :foo_h form
 my $loaded;
@@ -20,13 +30,14 @@ sub import {
 }
 
 sub croak { require Carp;  goto &Carp::croak }
+# declare usage to assist AutoLoad
+sub usage;
 
 XSLoader::load 'POSIX', $VERSION;
 
-my $EINVAL = constant("EINVAL", 0);
-my $EAGAIN = constant("EAGAIN", 0);
-
 sub AUTOLOAD {
+    no strict;
+    no warnings 'uninitialized';
     if ($AUTOLOAD =~ /::(_?[a-z])/) {
 	# require AutoLoader;
 	$AutoLoader::AUTOLOAD = $AUTOLOAD;
@@ -35,51 +46,53 @@ sub AUTOLOAD {
     local $! = 0;
     my $constname = $AUTOLOAD;
     $constname =~ s/.*:://;
-    my $val = constant($constname, @_ ? $_[0] : 0);
-    if ($! == 0) {
-	*$AUTOLOAD = sub { $val };
-    }
-    elsif ($! == $EAGAIN) {	# Not really a constant, so always call.
-	*$AUTOLOAD = sub { constant($constname, $_[0]) };
-    }
-    elsif ($! == $EINVAL) {
-	croak "$constname is not a valid POSIX macro";
-    }
-    else {
-	croak "Your vendor has not defined POSIX macro $constname, used";
-    }
+    my ($error, $val) = constant($constname);
+    croak $error if $error;
+    *$AUTOLOAD = sub { $val };
 
     goto &$AUTOLOAD;
 }
 
-sub usage { 
+package POSIX::SigAction;
+
+use AutoLoader 'AUTOLOAD';
+
+package POSIX::SigRt;
+
+use AutoLoader 'AUTOLOAD';
+
+use Tie::Hash;
+
+use vars qw($SIGACTION_FLAGS $_SIGRTMIN $_SIGRTMAX $_sigrtn @ISA);
+@POSIX::SigRt::ISA = qw(Tie::StdHash);
+
+$SIGACTION_FLAGS = 0;
+
+tie %POSIX::SIGRT, 'POSIX::SigRt';
+
+sub DESTROY {};
+
+package POSIX;
+
+1;
+__END__
+
+sub usage {
     my ($mess) = @_;
     croak "Usage: POSIX::$mess";
 }
 
-sub redef { 
+sub redef {
     my ($mess) = @_;
     croak "Use method $mess instead";
 }
 
-sub unimpl { 
+sub unimpl {
     my ($mess) = @_;
     $mess =~ s/xxx//;
     croak "Unimplemented: POSIX::$mess";
 }
 
-############################
-package POSIX::SigAction;
-
-sub new {
-    bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
-}
-
-############################
-package POSIX; # return to package POSIX so AutoSplit is happy
-1;
-__END__
-
 sub assert {
     usage "assert(expr)" if @_ != 1;
     if (!$_[0]) {
@@ -285,6 +298,10 @@ sub fseek {
     redef "IO::Seekable::seek()";
 }
 
+sub fsync {
+    redef "IO::Handle::sync()";
+}
+
 sub ferror {
     redef "IO::Handle::error()";
 }
@@ -348,7 +365,7 @@ sub puts {
 
 sub remove {
     usage "remove(filename)" if @_ != 1;
-    CORE::unlink($_[0]);
+    (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]);
 }
 
 sub rename {
@@ -424,7 +441,7 @@ sub calloc {
 }
 
 sub div {
-    unimpl "div() is C-specific, stopped";
+    unimpl "div() is C-specific, use /, % and int instead";
 }
 
 sub exit {
@@ -446,7 +463,7 @@ sub labs {
 }
 
 sub ldiv {
-    unimpl "ldiv() is C-specific, use / and int instead";
+    unimpl "ldiv() is C-specific, use /, % and int instead";
 }
 
 sub malloc {
@@ -622,7 +639,7 @@ sub chdir {
 }
 
 sub chown {
-    usage "chown(filename, uid, gid)" if @_ != 3;
+    usage "chown(uid, gid, filename)" if @_ != 3;
     CORE::chown($_[0], $_[1], $_[2]);
 }
 
@@ -655,20 +672,6 @@ sub fork {
     CORE::fork;
 }
 
-sub getcwd
-{
-    usage "getcwd()" if @_ != 0;
-    if ($^O eq 'MSWin32') {
-	# this perhaps applies to everyone else also?
-	require Cwd;
-	$cwd = &Cwd::cwd;
-    }
-    else {
-	chop($cwd = `pwd`);
-    }
-    $cwd;
-}
-
 sub getegid {
     usage "getegid()" if @_ != 0;
     $) + 0;
@@ -740,7 +743,7 @@ sub setvbuf {
 
 sub sleep {
     usage "sleep(seconds)" if @_ != 1;
-    CORE::sleep($_[0]);
+    $_[0] - CORE::sleep($_[0]);
 }
 
 sub unlink {
@@ -761,7 +764,7 @@ sub load_imports {
     ctype_h =>	[qw(isalnum isalpha iscntrl isdigit isgraph islower
 		isprint ispunct isspace isupper isxdigit tolower toupper)],
 
-    dirent_h =>	[qw()],
+    dirent_h =>	[],
 
     errno_h =>	[qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
 		EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
@@ -798,7 +801,7 @@ sub load_imports {
 		LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
 		LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
 
-    grp_h =>	[qw()],
+    grp_h =>	[],
 
     limits_h =>	[qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
 		INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
@@ -811,25 +814,26 @@ sub load_imports {
 		_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
 		_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
 
-    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC
-		LC_TIME NULL localeconv setlocale)],
+    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES
+		    LC_MONETARY LC_NUMERIC LC_TIME NULL
+		    localeconv setlocale)],
 
     math_h =>	[qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
 		frexp ldexp log10 modf pow sinh tan tanh)],
 
-    pwd_h =>	[qw()],
+    pwd_h =>	[],
 
     setjmp_h =>	[qw(longjmp setjmp siglongjmp sigsetjmp)],
 
     signal_h =>	[qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
 		SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
 		SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
-		SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
-		SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
-		SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
-		sigpending sigprocmask sigsuspend)],
+		SIGPIPE %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP
+		SIGTERM SIGTSTP SIGTTIN	SIGTTOU SIGUSR1 SIGUSR2
+		SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
+		raise sigaction signal sigpending sigprocmask sigsuspend)],
 
-    stdarg_h =>	[qw()],
+    stdarg_h =>	[],
 
     stddef_h =>	[qw(NULL offsetof)],
 
@@ -858,9 +862,9 @@ sub load_imports {
 		S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
 		fstat mkfifo)],
 
-    sys_times_h => [qw()],
+    sys_times_h => [],
 
-    sys_types_h => [qw()],
+    sys_types_h => [],
 
     sys_utsname_h => [qw(uname)],
 
@@ -890,41 +894,149 @@ sub load_imports {
 		_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
 		_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
 		_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
-		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS
+		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
 		_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
 		_exit access ctermid cuserid
 		dup2 dup execl execle execlp execv execve execvp
-		fpathconf getcwd getegid geteuid getgid getgroups
+		fpathconf fsync getcwd getegid geteuid getgid getgroups
 		getpid getuid isatty lseek pathconf pause setgid setpgid
 		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
 
-    utime_h =>	[qw()],
+    utime_h =>	[],
 
 );
 
 # Exporter::export_tags();
-for (values %EXPORT_TAGS) {
-  push @EXPORT, @$_;
+{
+  # De-duplicate the export list: 
+  my %export;
+  @export{map {@$_} values %EXPORT_TAGS} = ();
+  # Doing the de-dup with a temporary hash has the advantage that the SVs in
+  # @EXPORT are actually shared hash key sacalars, which will save some memory.
+  push @EXPORT, keys %export;
 }
 
 @EXPORT_OK = qw(
-    closedir opendir readdir rewinddir
-    fcntl open
-    getgrgid getgrnam
-    atan2 cos exp log sin sqrt
-    getpwnam getpwuid
-    kill
-    fileno getc printf rename sprintf
-    abs exit rand srand system
-    chmod mkdir stat umask
-    times
-    wait waitpid
-    gmtime localtime time 
-    alarm chdir chown close fork getlogin getppid getpgrp link
-	pipe read rmdir sleep unlink write
-    utime
-    nice
+		abs
+		alarm
+		atan2
+		chdir
+		chmod
+		chown
+		close
+		closedir
+		cos
+		exit
+		exp
+		fcntl
+		fileno
+		fork
+		getc
+		getgrgid
+		getgrnam
+		getlogin
+		getpgrp
+		getppid
+		getpwnam
+		getpwuid
+		gmtime
+		isatty
+		kill
+		lchown
+		link
+		localtime
+		log
+		mkdir
+		nice
+		open
+		opendir
+		pipe
+		printf
+		rand
+		read
+		readdir
+		rename
+		rewinddir
+		rmdir
+		sin
+		sleep
+		sprintf
+		sqrt
+		srand
+		stat
+		system
+		time
+		times
+		umask
+		unlink
+		utime
+		wait
+		waitpid
+		write
 );
 
 require Exporter;
 }
+
+package POSIX::SigAction;
+
+sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] }
+sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} };
+sub mask    { $_[0]->{MASK}    = $_[1] if @_ > 1; $_[0]->{MASK} };
+sub flags   { $_[0]->{FLAGS}   = $_[1] if @_ > 1; $_[0]->{FLAGS} };
+sub safe    { $_[0]->{SAFE}    = $_[1] if @_ > 1; $_[0]->{SAFE} };
+
+package POSIX::SigRt;
+
+
+sub _init {
+    $_SIGRTMIN = &POSIX::SIGRTMIN;
+    $_SIGRTMAX = &POSIX::SIGRTMAX;
+    $_sigrtn   = $_SIGRTMAX - $_SIGRTMIN;
+}
+
+sub _croak {
+    &_init unless defined $_sigrtn;
+    die "POSIX::SigRt not available" unless defined $_sigrtn && $_sigrtn > 0;
+}
+
+sub _getsig {
+    &_croak;
+    my $rtsig = $_[0];
+    # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C.
+    $rtsig = $_SIGRTMIN + ($1 || 0)
+	if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/;
+    return $rtsig;
+}
+
+sub _exist {
+    my $rtsig = _getsig($_[1]);
+    my $ok    = $rtsig >= $_SIGRTMIN && $rtsig <= $_SIGRTMAX;
+    ($rtsig, $ok);
+}
+
+sub _check {
+    my ($rtsig, $ok) = &_exist;
+    die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $_SIGRTMIN..$_SIGRTMAX)"
+	unless $ok;
+    return $rtsig;
+}
+
+sub new {
+    my ($rtsig, $handler, $flags) = @_;
+    my $sigset = POSIX::SigSet->new($rtsig);
+    my $sigact = POSIX::SigAction->new($handler,
+				       $sigset,
+				       $flags);
+    POSIX::sigaction($rtsig, $sigact);
+}
+
+sub EXISTS { &_exist }
+sub FETCH  { my $rtsig = &_check;
+	     my $oa = POSIX::SigAction->new();
+	     POSIX::sigaction($rtsig, undef, $oa);
+	     return $oa->{HANDLER} }
+sub STORE  { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) }
+sub DELETE { delete $SIG{ &_check } }
+sub CLEAR  { &_exist; delete @SIG{ &POSIX::SIGRTMIN .. &POSIX::SIGRTMAX } }
+sub SCALAR { &_croak; $_sigrtn + 1 }