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.18";
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;
}
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;
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]) {
redef "IO::Seekable::seek()";
}
+sub fsync {
+ redef "IO::Handle::sync()";
+}
+
sub ferror {
redef "IO::Handle::error()";
}
sub remove {
usage "remove(filename)" if @_ != 1;
- CORE::unlink($_[0]);
+ (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]);
}
sub rename {
}
sub div {
- unimpl "div() is C-specific, stopped";
+ unimpl "div() is C-specific, use /, % and int instead";
}
sub exit {
}
sub ldiv {
- unimpl "ldiv() is C-specific, use / and int instead";
+ unimpl "ldiv() is C-specific, use /, % and int instead";
}
sub malloc {
}
sub chown {
- usage "chown(filename, uid, gid)" if @_ != 3;
+ usage "chown(uid, gid, filename)" if @_ != 3;
CORE::chown($_[0], $_[1], $_[2]);
}
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;
sub sleep {
usage "sleep(seconds)" if @_ != 1;
- CORE::sleep($_[0]);
+ $_[0] - CORE::sleep($_[0]);
}
sub unlink {
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
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
_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)],
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)],
_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 }
projects / p5sagit/p5-mst-13.2.git / blobdiff