mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-27 00:17:54 +00:00
1038 lines
20 KiB
Perl
1038 lines
20 KiB
Perl
|
package POSIX;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
|
||
|
|
||
|
our $VERSION = "1.24";
|
||
|
|
||
|
use AutoLoader;
|
||
|
|
||
|
require XSLoader;
|
||
|
|
||
|
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 import {
|
||
|
load_imports() unless $loaded++;
|
||
|
my $this = shift;
|
||
|
my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
|
||
|
local $Exporter::ExportLevel = 1;
|
||
|
Exporter::import($this,@list);
|
||
|
}
|
||
|
|
||
|
sub croak { require Carp; goto &Carp::croak }
|
||
|
# declare usage to assist AutoLoad
|
||
|
sub usage;
|
||
|
|
||
|
XSLoader::load();
|
||
|
|
||
|
sub AUTOLOAD {
|
||
|
no warnings 'uninitialized';
|
||
|
if ($AUTOLOAD =~ /::(_?[a-z])/) {
|
||
|
# require AutoLoader;
|
||
|
$AutoLoader::AUTOLOAD = $AUTOLOAD;
|
||
|
goto &AutoLoader::AUTOLOAD
|
||
|
}
|
||
|
my $constname = $AUTOLOAD;
|
||
|
$constname =~ s/.*:://;
|
||
|
constant($constname);
|
||
|
}
|
||
|
|
||
|
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 {
|
||
|
my ($mess) = @_;
|
||
|
croak "Use method $mess instead";
|
||
|
}
|
||
|
|
||
|
sub unimpl {
|
||
|
my ($mess) = @_;
|
||
|
$mess =~ s/xxx//;
|
||
|
croak "Unimplemented: POSIX::$mess";
|
||
|
}
|
||
|
|
||
|
sub assert {
|
||
|
usage "assert(expr)" if @_ != 1;
|
||
|
if (!$_[0]) {
|
||
|
croak "Assertion failed";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub tolower {
|
||
|
usage "tolower(string)" if @_ != 1;
|
||
|
lc($_[0]);
|
||
|
}
|
||
|
|
||
|
sub toupper {
|
||
|
usage "toupper(string)" if @_ != 1;
|
||
|
uc($_[0]);
|
||
|
}
|
||
|
|
||
|
sub closedir {
|
||
|
usage "closedir(dirhandle)" if @_ != 1;
|
||
|
CORE::closedir($_[0]);
|
||
|
}
|
||
|
|
||
|
sub opendir {
|
||
|
usage "opendir(directory)" if @_ != 1;
|
||
|
my $dirhandle;
|
||
|
CORE::opendir($dirhandle, $_[0])
|
||
|
? $dirhandle
|
||
|
: undef;
|
||
|
}
|
||
|
|
||
|
sub readdir {
|
||
|
usage "readdir(dirhandle)" if @_ != 1;
|
||
|
CORE::readdir($_[0]);
|
||
|
}
|
||
|
|
||
|
sub rewinddir {
|
||
|
usage "rewinddir(dirhandle)" if @_ != 1;
|
||
|
CORE::rewinddir($_[0]);
|
||
|
}
|
||
|
|
||
|
sub errno {
|
||
|
usage "errno()" if @_ != 0;
|
||
|
$! + 0;
|
||
|
}
|
||
|
|
||
|
sub creat {
|
||
|
usage "creat(filename, mode)" if @_ != 2;
|
||
|
&open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
|
||
|
}
|
||
|
|
||
|
sub fcntl {
|
||
|
usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
|
||
|
CORE::fcntl($_[0], $_[1], $_[2]);
|
||
|
}
|
||
|
|
||
|
sub getgrgid {
|
||
|
usage "getgrgid(gid)" if @_ != 1;
|
||
|
CORE::getgrgid($_[0]);
|
||
|
}
|
||
|
|
||
|
sub getgrnam {
|
||
|
usage "getgrnam(name)" if @_ != 1;
|
||
|
CORE::getgrnam($_[0]);
|
||
|
}
|
||
|
|
||
|
sub atan2 {
|
||
|
usage "atan2(x,y)" if @_ != 2;
|
||
|
CORE::atan2($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub cos {
|
||
|
usage "cos(x)" if @_ != 1;
|
||
|
CORE::cos($_[0]);
|
||
|
}
|
||
|
|
||
|
sub exp {
|
||
|
usage "exp(x)" if @_ != 1;
|
||
|
CORE::exp($_[0]);
|
||
|
}
|
||
|
|
||
|
sub fabs {
|
||
|
usage "fabs(x)" if @_ != 1;
|
||
|
CORE::abs($_[0]);
|
||
|
}
|
||
|
|
||
|
sub log {
|
||
|
usage "log(x)" if @_ != 1;
|
||
|
CORE::log($_[0]);
|
||
|
}
|
||
|
|
||
|
sub pow {
|
||
|
usage "pow(x,exponent)" if @_ != 2;
|
||
|
$_[0] ** $_[1];
|
||
|
}
|
||
|
|
||
|
sub sin {
|
||
|
usage "sin(x)" if @_ != 1;
|
||
|
CORE::sin($_[0]);
|
||
|
}
|
||
|
|
||
|
sub sqrt {
|
||
|
usage "sqrt(x)" if @_ != 1;
|
||
|
CORE::sqrt($_[0]);
|
||
|
}
|
||
|
|
||
|
sub getpwnam {
|
||
|
usage "getpwnam(name)" if @_ != 1;
|
||
|
CORE::getpwnam($_[0]);
|
||
|
}
|
||
|
|
||
|
sub getpwuid {
|
||
|
usage "getpwuid(uid)" if @_ != 1;
|
||
|
CORE::getpwuid($_[0]);
|
||
|
}
|
||
|
|
||
|
sub longjmp {
|
||
|
unimpl "longjmp() is C-specific: use die instead";
|
||
|
}
|
||
|
|
||
|
sub setjmp {
|
||
|
unimpl "setjmp() is C-specific: use eval {} instead";
|
||
|
}
|
||
|
|
||
|
sub siglongjmp {
|
||
|
unimpl "siglongjmp() is C-specific: use die instead";
|
||
|
}
|
||
|
|
||
|
sub sigsetjmp {
|
||
|
unimpl "sigsetjmp() is C-specific: use eval {} instead";
|
||
|
}
|
||
|
|
||
|
sub kill {
|
||
|
usage "kill(pid, sig)" if @_ != 2;
|
||
|
CORE::kill $_[1], $_[0];
|
||
|
}
|
||
|
|
||
|
sub raise {
|
||
|
usage "raise(sig)" if @_ != 1;
|
||
|
CORE::kill $_[0], $$; # Is this good enough?
|
||
|
}
|
||
|
|
||
|
sub offsetof {
|
||
|
unimpl "offsetof() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub clearerr {
|
||
|
redef "IO::Handle::clearerr()";
|
||
|
}
|
||
|
|
||
|
sub fclose {
|
||
|
redef "IO::Handle::close()";
|
||
|
}
|
||
|
|
||
|
sub fdopen {
|
||
|
redef "IO::Handle::new_from_fd()";
|
||
|
}
|
||
|
|
||
|
sub feof {
|
||
|
redef "IO::Handle::eof()";
|
||
|
}
|
||
|
|
||
|
sub fgetc {
|
||
|
redef "IO::Handle::getc()";
|
||
|
}
|
||
|
|
||
|
sub fgets {
|
||
|
redef "IO::Handle::gets()";
|
||
|
}
|
||
|
|
||
|
sub fileno {
|
||
|
redef "IO::Handle::fileno()";
|
||
|
}
|
||
|
|
||
|
sub fopen {
|
||
|
redef "IO::File::open()";
|
||
|
}
|
||
|
|
||
|
sub fprintf {
|
||
|
unimpl "fprintf() is C-specific--use printf instead";
|
||
|
}
|
||
|
|
||
|
sub fputc {
|
||
|
unimpl "fputc() is C-specific--use print instead";
|
||
|
}
|
||
|
|
||
|
sub fputs {
|
||
|
unimpl "fputs() is C-specific--use print instead";
|
||
|
}
|
||
|
|
||
|
sub fread {
|
||
|
unimpl "fread() is C-specific--use read instead";
|
||
|
}
|
||
|
|
||
|
sub freopen {
|
||
|
unimpl "freopen() is C-specific--use open instead";
|
||
|
}
|
||
|
|
||
|
sub fscanf {
|
||
|
unimpl "fscanf() is C-specific--use <> and regular expressions instead";
|
||
|
}
|
||
|
|
||
|
sub fseek {
|
||
|
redef "IO::Seekable::seek()";
|
||
|
}
|
||
|
|
||
|
sub fsync {
|
||
|
redef "IO::Handle::sync()";
|
||
|
}
|
||
|
|
||
|
sub ferror {
|
||
|
redef "IO::Handle::error()";
|
||
|
}
|
||
|
|
||
|
sub fflush {
|
||
|
redef "IO::Handle::flush()";
|
||
|
}
|
||
|
|
||
|
sub fgetpos {
|
||
|
redef "IO::Seekable::getpos()";
|
||
|
}
|
||
|
|
||
|
sub fsetpos {
|
||
|
redef "IO::Seekable::setpos()";
|
||
|
}
|
||
|
|
||
|
sub ftell {
|
||
|
redef "IO::Seekable::tell()";
|
||
|
}
|
||
|
|
||
|
sub fwrite {
|
||
|
unimpl "fwrite() is C-specific--use print instead";
|
||
|
}
|
||
|
|
||
|
sub getc {
|
||
|
usage "getc(handle)" if @_ != 1;
|
||
|
CORE::getc($_[0]);
|
||
|
}
|
||
|
|
||
|
sub getchar {
|
||
|
usage "getchar()" if @_ != 0;
|
||
|
CORE::getc(STDIN);
|
||
|
}
|
||
|
|
||
|
sub gets {
|
||
|
usage "gets()" if @_ != 0;
|
||
|
scalar <STDIN>;
|
||
|
}
|
||
|
|
||
|
sub perror {
|
||
|
print STDERR "@_: " if @_;
|
||
|
print STDERR $!,"\n";
|
||
|
}
|
||
|
|
||
|
sub printf {
|
||
|
usage "printf(pattern, args...)" if @_ < 1;
|
||
|
CORE::printf STDOUT @_;
|
||
|
}
|
||
|
|
||
|
sub putc {
|
||
|
unimpl "putc() is C-specific--use print instead";
|
||
|
}
|
||
|
|
||
|
sub putchar {
|
||
|
unimpl "putchar() is C-specific--use print instead";
|
||
|
}
|
||
|
|
||
|
sub puts {
|
||
|
unimpl "puts() is C-specific--use print instead";
|
||
|
}
|
||
|
|
||
|
sub remove {
|
||
|
usage "remove(filename)" if @_ != 1;
|
||
|
(-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]);
|
||
|
}
|
||
|
|
||
|
sub rename {
|
||
|
usage "rename(oldfilename, newfilename)" if @_ != 2;
|
||
|
CORE::rename($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub rewind {
|
||
|
usage "rewind(filehandle)" if @_ != 1;
|
||
|
CORE::seek($_[0],0,0);
|
||
|
}
|
||
|
|
||
|
sub scanf {
|
||
|
unimpl "scanf() is C-specific--use <> and regular expressions instead";
|
||
|
}
|
||
|
|
||
|
sub sprintf {
|
||
|
usage "sprintf(pattern,args)" if @_ == 0;
|
||
|
CORE::sprintf(shift,@_);
|
||
|
}
|
||
|
|
||
|
sub sscanf {
|
||
|
unimpl "sscanf() is C-specific--use regular expressions instead";
|
||
|
}
|
||
|
|
||
|
sub tmpfile {
|
||
|
redef "IO::File::new_tmpfile()";
|
||
|
}
|
||
|
|
||
|
sub ungetc {
|
||
|
redef "IO::Handle::ungetc()";
|
||
|
}
|
||
|
|
||
|
sub vfprintf {
|
||
|
unimpl "vfprintf() is C-specific";
|
||
|
}
|
||
|
|
||
|
sub vprintf {
|
||
|
unimpl "vprintf() is C-specific";
|
||
|
}
|
||
|
|
||
|
sub vsprintf {
|
||
|
unimpl "vsprintf() is C-specific";
|
||
|
}
|
||
|
|
||
|
sub abs {
|
||
|
usage "abs(x)" if @_ != 1;
|
||
|
CORE::abs($_[0]);
|
||
|
}
|
||
|
|
||
|
sub atexit {
|
||
|
unimpl "atexit() is C-specific: use END {} instead";
|
||
|
}
|
||
|
|
||
|
sub atof {
|
||
|
unimpl "atof() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub atoi {
|
||
|
unimpl "atoi() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub atol {
|
||
|
unimpl "atol() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub bsearch {
|
||
|
unimpl "bsearch() not supplied";
|
||
|
}
|
||
|
|
||
|
sub calloc {
|
||
|
unimpl "calloc() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub div {
|
||
|
unimpl "div() is C-specific, use /, % and int instead";
|
||
|
}
|
||
|
|
||
|
sub exit {
|
||
|
usage "exit(status)" if @_ != 1;
|
||
|
CORE::exit($_[0]);
|
||
|
}
|
||
|
|
||
|
sub free {
|
||
|
unimpl "free() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub getenv {
|
||
|
usage "getenv(name)" if @_ != 1;
|
||
|
$ENV{$_[0]};
|
||
|
}
|
||
|
|
||
|
sub labs {
|
||
|
unimpl "labs() is C-specific, use abs instead";
|
||
|
}
|
||
|
|
||
|
sub ldiv {
|
||
|
unimpl "ldiv() is C-specific, use /, % and int instead";
|
||
|
}
|
||
|
|
||
|
sub malloc {
|
||
|
unimpl "malloc() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub qsort {
|
||
|
unimpl "qsort() is C-specific, use sort instead";
|
||
|
}
|
||
|
|
||
|
sub rand {
|
||
|
unimpl "rand() is non-portable, use Perl's rand instead";
|
||
|
}
|
||
|
|
||
|
sub realloc {
|
||
|
unimpl "realloc() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub srand {
|
||
|
unimpl "srand()";
|
||
|
}
|
||
|
|
||
|
sub system {
|
||
|
usage "system(command)" if @_ != 1;
|
||
|
CORE::system($_[0]);
|
||
|
}
|
||
|
|
||
|
sub memchr {
|
||
|
unimpl "memchr() is C-specific, use index() instead";
|
||
|
}
|
||
|
|
||
|
sub memcmp {
|
||
|
unimpl "memcmp() is C-specific, use eq instead";
|
||
|
}
|
||
|
|
||
|
sub memcpy {
|
||
|
unimpl "memcpy() is C-specific, use = instead";
|
||
|
}
|
||
|
|
||
|
sub memmove {
|
||
|
unimpl "memmove() is C-specific, use = instead";
|
||
|
}
|
||
|
|
||
|
sub memset {
|
||
|
unimpl "memset() is C-specific, use x instead";
|
||
|
}
|
||
|
|
||
|
sub strcat {
|
||
|
unimpl "strcat() is C-specific, use .= instead";
|
||
|
}
|
||
|
|
||
|
sub strchr {
|
||
|
unimpl "strchr() is C-specific, use index() instead";
|
||
|
}
|
||
|
|
||
|
sub strcmp {
|
||
|
unimpl "strcmp() is C-specific, use eq instead";
|
||
|
}
|
||
|
|
||
|
sub strcpy {
|
||
|
unimpl "strcpy() is C-specific, use = instead";
|
||
|
}
|
||
|
|
||
|
sub strcspn {
|
||
|
unimpl "strcspn() is C-specific, use regular expressions instead";
|
||
|
}
|
||
|
|
||
|
sub strerror {
|
||
|
usage "strerror(errno)" if @_ != 1;
|
||
|
local $! = $_[0];
|
||
|
$! . "";
|
||
|
}
|
||
|
|
||
|
sub strlen {
|
||
|
unimpl "strlen() is C-specific, use length instead";
|
||
|
}
|
||
|
|
||
|
sub strncat {
|
||
|
unimpl "strncat() is C-specific, use .= instead";
|
||
|
}
|
||
|
|
||
|
sub strncmp {
|
||
|
unimpl "strncmp() is C-specific, use eq instead";
|
||
|
}
|
||
|
|
||
|
sub strncpy {
|
||
|
unimpl "strncpy() is C-specific, use = instead";
|
||
|
}
|
||
|
|
||
|
sub strpbrk {
|
||
|
unimpl "strpbrk() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub strrchr {
|
||
|
unimpl "strrchr() is C-specific, use rindex() instead";
|
||
|
}
|
||
|
|
||
|
sub strspn {
|
||
|
unimpl "strspn() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub strstr {
|
||
|
usage "strstr(big, little)" if @_ != 2;
|
||
|
CORE::index($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub strtok {
|
||
|
unimpl "strtok() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub chmod {
|
||
|
usage "chmod(mode, filename)" if @_ != 2;
|
||
|
CORE::chmod($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub fstat {
|
||
|
usage "fstat(fd)" if @_ != 1;
|
||
|
local *TMP;
|
||
|
CORE::open(TMP, "<&$_[0]"); # Gross.
|
||
|
my @l = CORE::stat(TMP);
|
||
|
CORE::close(TMP);
|
||
|
@l;
|
||
|
}
|
||
|
|
||
|
sub mkdir {
|
||
|
usage "mkdir(directoryname, mode)" if @_ != 2;
|
||
|
CORE::mkdir($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub stat {
|
||
|
usage "stat(filename)" if @_ != 1;
|
||
|
CORE::stat($_[0]);
|
||
|
}
|
||
|
|
||
|
sub umask {
|
||
|
usage "umask(mask)" if @_ != 1;
|
||
|
CORE::umask($_[0]);
|
||
|
}
|
||
|
|
||
|
sub wait {
|
||
|
usage "wait()" if @_ != 0;
|
||
|
CORE::wait();
|
||
|
}
|
||
|
|
||
|
sub waitpid {
|
||
|
usage "waitpid(pid, options)" if @_ != 2;
|
||
|
CORE::waitpid($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub gmtime {
|
||
|
usage "gmtime(time)" if @_ != 1;
|
||
|
CORE::gmtime($_[0]);
|
||
|
}
|
||
|
|
||
|
sub localtime {
|
||
|
usage "localtime(time)" if @_ != 1;
|
||
|
CORE::localtime($_[0]);
|
||
|
}
|
||
|
|
||
|
sub time {
|
||
|
usage "time()" if @_ != 0;
|
||
|
CORE::time;
|
||
|
}
|
||
|
|
||
|
sub alarm {
|
||
|
usage "alarm(seconds)" if @_ != 1;
|
||
|
CORE::alarm($_[0]);
|
||
|
}
|
||
|
|
||
|
sub chdir {
|
||
|
usage "chdir(directory)" if @_ != 1;
|
||
|
CORE::chdir($_[0]);
|
||
|
}
|
||
|
|
||
|
sub chown {
|
||
|
usage "chown(uid, gid, filename)" if @_ != 3;
|
||
|
CORE::chown($_[0], $_[1], $_[2]);
|
||
|
}
|
||
|
|
||
|
sub execl {
|
||
|
unimpl "execl() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub execle {
|
||
|
unimpl "execle() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub execlp {
|
||
|
unimpl "execlp() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub execv {
|
||
|
unimpl "execv() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub execve {
|
||
|
unimpl "execve() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub execvp {
|
||
|
unimpl "execvp() is C-specific, stopped";
|
||
|
}
|
||
|
|
||
|
sub fork {
|
||
|
usage "fork()" if @_ != 0;
|
||
|
CORE::fork;
|
||
|
}
|
||
|
|
||
|
sub getegid {
|
||
|
usage "getegid()" if @_ != 0;
|
||
|
$) + 0;
|
||
|
}
|
||
|
|
||
|
sub geteuid {
|
||
|
usage "geteuid()" if @_ != 0;
|
||
|
$> + 0;
|
||
|
}
|
||
|
|
||
|
sub getgid {
|
||
|
usage "getgid()" if @_ != 0;
|
||
|
$( + 0;
|
||
|
}
|
||
|
|
||
|
sub getgroups {
|
||
|
usage "getgroups()" if @_ != 0;
|
||
|
my %seen;
|
||
|
grep(!$seen{$_}++, split(' ', $) ));
|
||
|
}
|
||
|
|
||
|
sub getlogin {
|
||
|
usage "getlogin()" if @_ != 0;
|
||
|
CORE::getlogin();
|
||
|
}
|
||
|
|
||
|
sub getpgrp {
|
||
|
usage "getpgrp()" if @_ != 0;
|
||
|
CORE::getpgrp;
|
||
|
}
|
||
|
|
||
|
sub getpid {
|
||
|
usage "getpid()" if @_ != 0;
|
||
|
$$;
|
||
|
}
|
||
|
|
||
|
sub getppid {
|
||
|
usage "getppid()" if @_ != 0;
|
||
|
CORE::getppid;
|
||
|
}
|
||
|
|
||
|
sub getuid {
|
||
|
usage "getuid()" if @_ != 0;
|
||
|
$<;
|
||
|
}
|
||
|
|
||
|
sub isatty {
|
||
|
usage "isatty(filehandle)" if @_ != 1;
|
||
|
-t $_[0];
|
||
|
}
|
||
|
|
||
|
sub link {
|
||
|
usage "link(oldfilename, newfilename)" if @_ != 2;
|
||
|
CORE::link($_[0], $_[1]);
|
||
|
}
|
||
|
|
||
|
sub rmdir {
|
||
|
usage "rmdir(directoryname)" if @_ != 1;
|
||
|
CORE::rmdir($_[0]);
|
||
|
}
|
||
|
|
||
|
sub setbuf {
|
||
|
redef "IO::Handle::setbuf()";
|
||
|
}
|
||
|
|
||
|
sub setvbuf {
|
||
|
redef "IO::Handle::setvbuf()";
|
||
|
}
|
||
|
|
||
|
sub sleep {
|
||
|
usage "sleep(seconds)" if @_ != 1;
|
||
|
$_[0] - CORE::sleep($_[0]);
|
||
|
}
|
||
|
|
||
|
sub unlink {
|
||
|
usage "unlink(filename)" if @_ != 1;
|
||
|
CORE::unlink($_[0]);
|
||
|
}
|
||
|
|
||
|
sub utime {
|
||
|
usage "utime(filename, atime, mtime)" if @_ != 3;
|
||
|
CORE::utime($_[1], $_[2], $_[0]);
|
||
|
}
|
||
|
|
||
|
sub load_imports {
|
||
|
%EXPORT_TAGS = (
|
||
|
|
||
|
assert_h => [qw(assert NDEBUG)],
|
||
|
|
||
|
ctype_h => [qw(isalnum isalpha iscntrl isdigit isgraph islower
|
||
|
isprint ispunct isspace isupper isxdigit tolower toupper)],
|
||
|
|
||
|
dirent_h => [],
|
||
|
|
||
|
errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
|
||
|
EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
|
||
|
ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
|
||
|
EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
|
||
|
EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
|
||
|
EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
|
||
|
ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
|
||
|
ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
|
||
|
ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
|
||
|
EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
|
||
|
ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
|
||
|
ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
|
||
|
EUSERS EWOULDBLOCK EXDEV errno)],
|
||
|
|
||
|
fcntl_h => [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
|
||
|
creat
|
||
|
SEEK_CUR SEEK_END SEEK_SET
|
||
|
S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
|
||
|
S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
|
||
|
S_IWGRP S_IWOTH S_IWUSR)],
|
||
|
|
||
|
float_h => [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
|
||
|
DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
|
||
|
DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
|
||
|
FLT_DIG FLT_EPSILON FLT_MANT_DIG
|
||
|
FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
|
||
|
FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
|
||
|
FLT_RADIX FLT_ROUNDS
|
||
|
LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
|
||
|
LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
|
||
|
LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
|
||
|
|
||
|
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
|
||
|
MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
|
||
|
PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
|
||
|
SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
|
||
|
ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
|
||
|
_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
|
||
|
_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
|
||
|
_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_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 => [],
|
||
|
|
||
|
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 %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP
|
||
|
SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGBUS
|
||
|
SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ
|
||
|
SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
|
||
|
raise sigaction signal sigpending sigprocmask sigsuspend)],
|
||
|
|
||
|
stdarg_h => [],
|
||
|
|
||
|
stddef_h => [qw(NULL offsetof)],
|
||
|
|
||
|
stdio_h => [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
|
||
|
L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
|
||
|
STREAM_MAX TMP_MAX stderr stdin stdout
|
||
|
clearerr fclose fdopen feof ferror fflush fgetc fgetpos
|
||
|
fgets fopen fprintf fputc fputs fread freopen
|
||
|
fscanf fseek fsetpos ftell fwrite getchar gets
|
||
|
perror putc putchar puts remove rewind
|
||
|
scanf setbuf setvbuf sscanf tmpfile tmpnam
|
||
|
ungetc vfprintf vprintf vsprintf)],
|
||
|
|
||
|
stdlib_h => [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
|
||
|
abort atexit atof atoi atol bsearch calloc div
|
||
|
free getenv labs ldiv malloc mblen mbstowcs mbtowc
|
||
|
qsort realloc strtod strtol strtoul wcstombs wctomb)],
|
||
|
|
||
|
string_h => [qw(NULL memchr memcmp memcpy memmove memset strcat
|
||
|
strchr strcmp strcoll strcpy strcspn strerror strlen
|
||
|
strncat strncmp strncpy strpbrk strrchr strspn strstr
|
||
|
strtok strxfrm)],
|
||
|
|
||
|
sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
|
||
|
S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
|
||
|
S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
|
||
|
fstat mkfifo)],
|
||
|
|
||
|
sys_times_h => [],
|
||
|
|
||
|
sys_types_h => [],
|
||
|
|
||
|
sys_utsname_h => [qw(uname)],
|
||
|
|
||
|
sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
|
||
|
WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
|
||
|
|
||
|
termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
|
||
|
B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
|
||
|
CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
|
||
|
ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
|
||
|
INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
|
||
|
PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
|
||
|
TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
|
||
|
TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
|
||
|
VSTOP VSUSP VTIME
|
||
|
cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
|
||
|
tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
|
||
|
|
||
|
time_h => [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
|
||
|
difftime mktime strftime tzset tzname)],
|
||
|
|
||
|
unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
|
||
|
STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
|
||
|
_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
|
||
|
_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
|
||
|
_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
|
||
|
_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_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 fsync getcwd getegid geteuid getgid getgroups
|
||
|
getpid getuid isatty lseek pathconf pause setgid setpgid
|
||
|
setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
|
||
|
|
||
|
utime_h => [],
|
||
|
|
||
|
);
|
||
|
|
||
|
# Exporter::export_tags();
|
||
|
{
|
||
|
# 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 scalars, which will save some memory.
|
||
|
push @EXPORT, keys %export;
|
||
|
}
|
||
|
|
||
|
@EXPORT_OK = qw(
|
||
|
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 }
|