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
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
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]};
+ bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
}
############################
-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]);
-}
-
-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;
__END__
sub closedir {
usage "closedir(dirhandle)" if @_ != 1;
closedir($_[0]);
- ungensym($_[0]);
}
sub opendir {
usage "opendir(directory)" if @_ != 1;
- local($dirhandle) = &gensym;
+ my $dirhandle = gensym;
opendir($dirhandle, $_[0])
? $dirhandle
- : (ungensym($dirhandle), undef);
+ : undef;
}
sub readdir {
sqrt($_[0]);
}
-sub tan {
- usage "tan(x)" if @_ != 1;
- tan($_[0]);
-}
-
sub getpwnam {
usage "getpwnam(name)" if @_ != 1;
getpwnam($_[0]);
sub raise {
usage "raise(sig)" if @_ != 1;
- kill $$, $_[0]; # Is this good enough?
+ 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 tmpfile {
- redef "FileHandle->new_tmpfile()";
+ redef "IO::File::new_tmpfile()";
}
sub ungetc {
- redef "$filehandle->ungetc(char)";
+ redef "IO::Handle::ungetc()";
}
sub vfprintf {
}
sub bsearch {
- unimpl "bsearch(xxx)" if @_ != 123;
- bsearch($_[0]);
+ unimpl "bsearch() not supplied";
}
sub calloc {
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]);
sub memcpy {
unimpl "memcpy() is C-specific, use = instead";
- memcpy($_[0]);
+}
sub memmove {
unimpl "memmove() is C-specific, use = instead";
}
sub chmod {
- usage "chmod(filename, mode)" if @_ != 2;
+ usage "chmod(mode, filename)" if @_ != 2;
chmod($_[0], $_[1]);
}
sub fstat {
usage "fstat(fd)" if @_ != 1;
- local(*TMP);
+ local *TMP;
open(TMP, "<&$_[0]"); # Gross.
- local(@l) = stat(TMP);
+ my @l = stat(TMP);
close(TMP);
@l;
}
umask($_[0]);
}
-sub times {
- usage "times()" if @_ != 0;
- times();
-}
-
sub wait {
- usage "wait(statusvariable)" if @_ != 1;
- local $result = wait();
- $_[0] = $?;
- $result;
+ usage "wait()" if @_ != 0;
+ wait();
}
sub waitpid {
- usage "waitpid(pid, statusvariable, options)" if @_ != 3;
- local $result = waitpid($_[0], $_[2]);
- $_[1] = $?;
- $result;
+ usage "waitpid(pid, options)" if @_ != 2;
+ waitpid($_[0], $_[1]);
}
sub gmtime {
}
sub time {
- unimpl "time()" if @_ != 0;
+ usage "time()" if @_ != 0;
time;
}
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 {
sub getgroups {
usage "getgroups()" if @_ != 0;
- local(%seen) = ();
+ my %seen;
grep(!$seen{$_}++, split(' ', $) ));
}
projects / p5sagit/p5-mst-13.2.git / blobdiff