package POSIX;
+use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK $AUTOLOAD);
+
use Carp;
+use AutoLoader;
+require Config;
+use Symbol;
+
require Exporter;
-require AutoLoader;
require DynaLoader;
-require Config;
@ISA = qw(Exporter DynaLoader);
+$VERSION = "1.02" ;
+
%EXPORT_TAGS = (
assert_h => [qw(assert NDEBUG)],
dirent_h => [qw()],
- errno_h => [qw(E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM
- EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE
- EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK
- ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO
- EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV errno)],
+ 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
_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_STREADM_MAX _POSIX_TZNAME_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)],
math_h => [qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
- frexp ldexp log10 modf pow sinh tanh)],
+ frexp ldexp log10 modf pow sinh tan tanh)],
pwd_h => [qw()],
setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)],
- signal_h => [qw(SA_NOCLDSTOP 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)],
+ 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)],
stdarg_h => [qw()],
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 _IOFBF _IOLBF _IONBF
+ 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
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 stroul wcstombs wctomb)],
+ qsort realloc strtod strtol strtoul wcstombs wctomb)],
string_h => [qw(NULL memchr memcmp memcpy memmove memset strcat
strchr strcmp strcoll strcpy strcspn strerror strlen
closedir opendir readdir rewinddir
fcntl open
getgrgid getgrnam
- atan2 cos exp log sin sqrt tan
+ atan2 cos exp log sin sqrt
getpwnam getpwuid
kill
fileno getc printf rename sprintf
alarm chdir chown close fork getlogin getppid getpgrp link
pipe read rmdir sleep unlink write
utime
+ nice
);
# Grandfather old foo_h form to new :foo_h form
Exporter::import($this,@list);
}
+
+bootstrap POSIX $VERSION;
+
+my $EINVAL = constant("EINVAL", 0);
+my $EAGAIN = constant("EAGAIN", 0);
+
sub AUTOLOAD {
if ($AUTOLOAD =~ /::(_?[a-z])/) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD
}
- local $constname = $AUTOLOAD;
+ local $! = 0;
+ my $constname = $AUTOLOAD;
$constname =~ s/.*:://;
- $val = constant($constname, $_[0]);
- if ($! != 0) {
- if ($! =~ /Invalid/) {
- croak "$constname is not a valid POSIX macro";
- }
- else {
- croak "Your vendor has not defined POSIX macro $constname, used";
- }
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! == 0) {
+ *$AUTOLOAD = sub { $val };
}
- eval "sub $AUTOLOAD { $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";
+ }
+
goto &$AUTOLOAD;
}
-
-@liblist = ();
-@liblist = split ' ', $Config::Config{"POSIX_loadlibs"}
- if defined $Config::Config{"POSIX_loadlibs"};
-bootstrap POSIX @liblist;
-
sub usage {
- local ($mess) = @_;
+ my ($mess) = @_;
croak "Usage: POSIX::$mess";
}
sub redef {
- local ($mess) = @_;
+ my ($mess) = @_;
croak "Use method $mess instead";
}
sub unimpl {
- local ($mess) = @_;
+ my ($mess) = @_;
$mess =~ s/xxx//;
croak "Unimplemented: POSIX::$mess";
}
-$gensym = "SYM000";
-
-sub gensym {
- *{"POSIX::" . $gensym++};
-}
-
-sub ungensym {
- local($x) = shift;
- $x =~ s/.*:://;
- delete $POSIX::{$x};
-}
-
############################
package POSIX::SigAction;
sub new {
- bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3]};
-}
-
-############################
-package FileHandle;
-
-sub new {
- POSIX::usage "FileHandle->new(filename, posixmode)" if @_ != 3;
- local($class,$filename,$mode) = @_;
- local($glob) = &POSIX::gensym;
- $mode =~ s/a.*/>>/ ||
- $mode =~ s/w.*/>/ ||
- ($mode = '<');
- open($glob, "$mode $filename") and
- bless \$glob;
-}
-
-sub new_from_fd {
- POSIX::usage "FileHandle->new_from_fd(fd,mode)" if @_ != 3;
- local($class,$fd,$mode) = @_;
- local($glob) = &POSIX::gensym;
- $mode =~ s/a.*/>>/ ||
- $mode =~ s/w.*/>/ ||
- ($mode = '<');
- open($glob, "$mode&=$fd") and
- bless \$glob;
-}
-
-sub clearerr {
- POSIX::usage "clearerr(filehandle)" if @_ != 1;
- seek($_[0], 0, 1);
-}
-
-sub close {
- POSIX::usage "close(filehandle)" if @_ != 1;
- close($_[0]);
+ bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
}
-sub DESTROY {
- close($_[0]);
- ungensym($_[0]);
-}
-
-sub eof {
- POSIX::usage "eof(filehandle)" if @_ != 1;
- eof($_[0]);
-}
-
-sub getc {
- POSIX::usage "getc(filehandle)" if @_ != 1;
- getc($_[0]);
-}
-
-sub gets {
- POSIX::usage "gets(filehandle)" if @_ != 1;
- local($handle) = @_;
- scalar <$handle>;
-}
-
-sub fileno {
- POSIX::usage "fileno(filehandle)" if @_ != 1;
- fileno($_[0]);
-}
-
-sub seek {
- POSIX::usage "seek(filehandle,pos,whence)" if @_ != 3;
- seek($_[0], $_[1], $_[2]);
-}
-
-sub tell {
- POSIX::usage "tell(filehandle)" if @_ != 1;
- tell($_[0]);
-}
############################
package POSIX; # return to package POSIX so AutoSplit is happy
1;
sub closedir {
usage "closedir(dirhandle)" if @_ != 1;
- closedir($_[0]);
- ungensym($_[0]);
+ CORE::closedir($_[0]);
}
sub opendir {
usage "opendir(directory)" if @_ != 1;
- local($dirhandle) = &gensym;
- opendir($dirhandle, $_[0])
+ my $dirhandle = gensym;
+ CORE::opendir($dirhandle, $_[0])
? $dirhandle
- : (ungensym($dirhandle), undef);
+ : undef;
}
sub readdir {
usage "readdir(dirhandle)" if @_ != 1;
- readdir($_[0]);
+ CORE::readdir($_[0]);
}
sub rewinddir {
usage "rewinddir(dirhandle)" if @_ != 1;
- rewinddir($_[0]);
+ CORE::rewinddir($_[0]);
}
sub errno {
sub fcntl {
usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
- fcntl($_[0], $_[1], $_[2]);
+ CORE::fcntl($_[0], $_[1], $_[2]);
}
sub getgrgid {
usage "getgrgid(gid)" if @_ != 1;
- getgrgid($_[0]);
+ CORE::getgrgid($_[0]);
}
sub getgrnam {
usage "getgrnam(name)" if @_ != 1;
- getgrnam($_[0]);
+ CORE::getgrnam($_[0]);
}
sub atan2 {
usage "atan2(x,y)" if @_ != 2;
- atan2($_[0], $_[1]);
+ CORE::atan2($_[0], $_[1]);
}
sub cos {
usage "cos(x)" if @_ != 1;
- cos($_[0]);
+ CORE::cos($_[0]);
}
sub exp {
usage "exp(x)" if @_ != 1;
- exp($_[0]);
+ CORE::exp($_[0]);
}
sub fabs {
usage "fabs(x)" if @_ != 1;
- abs($_[0]);
+ CORE::abs($_[0]);
}
sub log {
usage "log(x)" if @_ != 1;
- log($_[0]);
+ CORE::log($_[0]);
}
sub pow {
sub sin {
usage "sin(x)" if @_ != 1;
- sin($_[0]);
+ CORE::sin($_[0]);
}
sub sqrt {
usage "sqrt(x)" if @_ != 1;
- sqrt($_[0]);
-}
-
-sub tan {
- usage "tan(x)" if @_ != 1;
- tan($_[0]);
+ CORE::sqrt($_[0]);
}
sub getpwnam {
usage "getpwnam(name)" if @_ != 1;
- getpwnam($_[0]);
+ CORE::getpwnam($_[0]);
}
sub getpwuid {
usage "getpwuid(uid)" if @_ != 1;
- getpwuid($_[0]);
+ CORE::getpwuid($_[0]);
}
sub longjmp {
sub kill {
usage "kill(pid, sig)" if @_ != 2;
- kill $_[1], $_[0];
+ CORE::kill $_[1], $_[0];
}
sub raise {
usage "raise(sig)" if @_ != 1;
- kill $$, $_[0]; # Is this good enough?
+ CORE::kill $_[0], $$; # Is this good enough?
}
sub offsetof {
}
sub clearerr {
- redef "$filehandle->clearerr(filehandle)";
+ redef "IO::Handle::clearerr()";
}
sub fclose {
- redef "$filehandle->fclose(filehandle)";
+ redef "IO::Handle::close()";
}
sub fdopen {
- redef "FileHandle->new_from_fd(fd,mode)";
+ redef "IO::Handle::new_from_fd()";
}
sub feof {
- redef "$filehandle->eof()";
+ redef "IO::Handle::eof()";
}
sub fgetc {
- redef "$filehandle->getc()";
+ redef "IO::Handle::getc()";
}
sub fgets {
- redef "$filehandle->gets()";
+ redef "IO::Handle::gets()";
}
sub fileno {
- redef "$filehandle->fileno()";
+ redef "IO::Handle::fileno()";
}
sub fopen {
- redef "FileHandle->open()";
+ redef "IO::File::open()";
}
sub fprintf {
}
sub fseek {
- redef "$filehandle->seek(pos,whence)";
+ redef "IO::Seekable::seek()";
}
sub ferror {
- redef "$filehandle->error()";
+ redef "IO::Handle::error()";
}
sub fflush {
- redef "$filehandle->flush()";
+ redef "IO::Handle::flush()";
}
sub fgetpos {
- redef "$filehandle->getpos()";
+ redef "IO::Seekable::getpos()";
}
sub fsetpos {
- redef "$filehandle->setpos(pos)";
+ redef "IO::Seekable::setpos()";
}
sub ftell {
- redef "$filehandle->tell()";
+ redef "IO::Seekable::tell()";
}
sub fwrite {
sub getc {
usage "getc(handle)" if @_ != 1;
- getc($_[0]);
+ CORE::getc($_[0]);
}
sub getchar {
usage "getchar()" if @_ != 0;
- getc(STDIN);
+ CORE::getc(STDIN);
}
sub gets {
sub printf {
usage "printf(pattern, args...)" if @_ < 1;
- printf STDOUT @_;
+ CORE::printf STDOUT @_;
}
sub putc {
sub remove {
usage "remove(filename)" if @_ != 1;
- unlink($_[0]);
+ CORE::unlink($_[0]);
}
sub rename {
usage "rename(oldfilename, newfilename)" if @_ != 2;
- rename($_[0], $_[1]);
+ CORE::rename($_[0], $_[1]);
}
sub rewind {
usage "rewind(filehandle)" if @_ != 1;
- seek($_[0],0,0);
+ CORE::seek($_[0],0,0);
}
sub scanf {
sub sprintf {
usage "sprintf(pattern,args)" if @_ == 0;
- sprintf(shift,@_);
+ CORE::sprintf(shift,@_);
}
sub sscanf {
}
sub tmpfile {
- redef "FileHandle->new_tmpfile()";
+ redef "IO::File::new_tmpfile()";
}
sub ungetc {
- redef "$filehandle->ungetc(char)";
+ redef "IO::Handle::ungetc()";
}
sub vfprintf {
sub abs {
usage "abs(x)" if @_ != 1;
- abs($_[0]);
+ CORE::abs($_[0]);
}
sub atexit {
}
sub bsearch {
- unimpl "bsearch(xxx)" if @_ != 123;
- bsearch($_[0]);
+ unimpl "bsearch() not supplied";
}
sub calloc {
sub exit {
usage "exit(status)" if @_ != 1;
- exit($_[0]);
+ CORE::exit($_[0]);
}
sub free {
unimpl "free() is C-specific, stopped";
- free($_[0]);
}
sub getenv {
unimpl "srand()";
}
-sub strtod {
- unimpl "strtod() is C-specific, stopped";
-}
-
-sub strtol {
- unimpl "strtol() is C-specific, stopped";
-}
-
-sub stroul {
- unimpl "stroul() is C-specific, stopped";
-}
-
sub system {
usage "system(command)" if @_ != 1;
- system($_[0]);
+ CORE::system($_[0]);
}
sub memchr {
sub memcpy {
unimpl "memcpy() is C-specific, use = instead";
- memcpy($_[0]);
+}
sub memmove {
unimpl "memmove() is C-specific, use = instead";
sub strstr {
usage "strstr(big, little)" if @_ != 2;
- index($_[0], $_[1]);
+ CORE::index($_[0], $_[1]);
}
sub strtok {
}
sub chmod {
- usage "chmod(filename, mode)" if @_ != 2;
- chmod($_[0], $_[1]);
+ usage "chmod(mode, filename)" if @_ != 2;
+ CORE::chmod($_[0], $_[1]);
}
sub fstat {
usage "fstat(fd)" if @_ != 1;
- local(*TMP);
+ local *TMP;
open(TMP, "<&$_[0]"); # Gross.
- local(@l) = stat(TMP);
+ my @l = CORE::stat(TMP);
close(TMP);
@l;
}
sub mkdir {
usage "mkdir(directoryname, mode)" if @_ != 2;
- mkdir($_[0], $_[1]);
+ CORE::mkdir($_[0], $_[1]);
}
sub stat {
usage "stat(filename)" if @_ != 1;
- stat($_[0]);
+ CORE::stat($_[0]);
}
sub umask {
usage "umask(mask)" if @_ != 1;
- umask($_[0]);
-}
-
-sub times {
- usage "times()" if @_ != 0;
- times();
+ CORE::umask($_[0]);
}
sub wait {
- usage "wait(statusvariable)" if @_ != 1;
- local $result = wait();
- $_[0] = $?;
- $result;
+ usage "wait()" if @_ != 0;
+ CORE::wait();
}
sub waitpid {
- usage "waitpid(pid, statusvariable, options)" if @_ != 3;
- local $result = waitpid($_[0], $_[2]);
- $_[1] = $?;
- $result;
+ usage "waitpid(pid, options)" if @_ != 2;
+ CORE::waitpid($_[0], $_[1]);
}
sub gmtime {
usage "gmtime(time)" if @_ != 1;
- gmtime($_[0]);
+ CORE::gmtime($_[0]);
}
sub localtime {
usage "localtime(time)" if @_ != 1;
- localtime($_[0]);
+ CORE::localtime($_[0]);
}
sub time {
- unimpl "time()" if @_ != 0;
- time;
+ usage "time()" if @_ != 0;
+ CORE::time;
}
sub alarm {
usage "alarm(seconds)" if @_ != 1;
- alarm($_[0]);
+ CORE::alarm($_[0]);
}
sub chdir {
usage "chdir(directory)" if @_ != 1;
- chdir($_[0]);
+ CORE::chdir($_[0]);
}
sub chown {
usage "chown(filename, uid, gid)" if @_ != 3;
- chown($_[0], $_[1], $_[2]);
+ CORE::chown($_[0], $_[1], $_[2]);
}
sub execl {
unimpl "execl() is C-specific, stopped";
- execl($_[0]);
}
sub execle {
unimpl "execle() is C-specific, stopped";
- execle($_[0]);
}
sub execlp {
unimpl "execlp() is C-specific, stopped";
- execlp($_[0]);
}
sub execv {
unimpl "execv() is C-specific, stopped";
- execv($_[0]);
}
sub execve {
unimpl "execve() is C-specific, stopped";
- execve($_[0]);
}
sub execvp {
unimpl "execvp() is C-specific, stopped";
- execvp($_[0]);
}
sub fork {
usage "fork()" if @_ != 0;
- fork;
+ CORE::fork;
}
sub getcwd
{
usage "getcwd()" if @_ != 0;
- chop($cwd = `pwd`);
+ if ($^O eq 'MSWin32') {
+ # this perhaps applies to everyone else also?
+ require Cwd;
+ $cwd = &Cwd::cwd;
+ }
+ else {
+ chop($cwd = `pwd`);
+ }
$cwd;
}
sub getgroups {
usage "getgroups()" if @_ != 0;
- local(%seen) = ();
+ my %seen;
grep(!$seen{$_}++, split(' ', $) ));
}
sub getlogin {
usage "getlogin()" if @_ != 0;
- getlogin();
+ CORE::getlogin();
}
sub getpgrp {
usage "getpgrp()" if @_ != 0;
- getpgrp($_[0]);
+ CORE::getpgrp;
}
sub getpid {
sub getppid {
usage "getppid()" if @_ != 0;
- getppid;
+ CORE::getppid;
}
sub getuid {
sub link {
usage "link(oldfilename, newfilename)" if @_ != 2;
- link($_[0], $_[1]);
+ CORE::link($_[0], $_[1]);
}
sub rmdir {
usage "rmdir(directoryname)" if @_ != 1;
- rmdir($_[0]);
+ CORE::rmdir($_[0]);
}
sub setgid {
sub sleep {
usage "sleep(seconds)" if @_ != 1;
- sleep($_[0]);
+ CORE::sleep($_[0]);
}
sub unlink {
usage "unlink(filename)" if @_ != 1;
- unlink($_[0]);
+ CORE::unlink($_[0]);
}
sub utime {
usage "utime(filename, atime, mtime)" if @_ != 3;
- utime($_[1], $_[2], $_[0]);
+ CORE::utime($_[1], $_[2], $_[0]);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff