X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.pm;h=76455f70dd073f7ead63e62d47083405a418159b;hb=5507c093461a5bb63a4cc7e16e5a935c61c49879;hp=b343200971b1bf864613b85d8e27e2866458fe80;hpb=748a93069b3d16374a9859d1456065dd3ae11394;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index b343200..76455f7 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -1,12 +1,18 @@ 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)], @@ -16,11 +22,19 @@ require Config; 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 @@ -54,32 +68,33 @@ require Config; _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 @@ -90,7 +105,7 @@ require Config; 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 @@ -152,7 +167,7 @@ Exporter::export_tags(); 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 @@ -164,6 +179,7 @@ Exporter::export_tags(); 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 @@ -174,137 +190,60 @@ sub import { 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; @@ -329,26 +268,25 @@ sub toupper { 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 { @@ -363,42 +301,42 @@ sub creat { 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 { @@ -408,27 +346,22 @@ 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 { @@ -449,12 +382,12 @@ sub sigsetjmp { 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 { @@ -462,35 +395,35 @@ 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 { @@ -518,27 +451,27 @@ sub fscanf { } 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 { @@ -547,12 +480,12 @@ 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 { @@ -567,7 +500,7 @@ sub perror { sub printf { usage "printf(pattern, args...)" if @_ < 1; - printf STDOUT @_; + CORE::printf STDOUT @_; } sub putc { @@ -584,17 +517,17 @@ sub puts { 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 { @@ -603,7 +536,7 @@ sub scanf { sub sprintf { usage "sprintf(pattern,args)" if @_ == 0; - sprintf(shift,@_); + CORE::sprintf(shift,@_); } sub sscanf { @@ -611,11 +544,11 @@ 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 { @@ -632,7 +565,7 @@ sub vsprintf { sub abs { usage "abs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub atexit { @@ -652,8 +585,7 @@ sub atol { } sub bsearch { - unimpl "bsearch(xxx)" if @_ != 123; - bsearch($_[0]); + unimpl "bsearch() not supplied"; } sub calloc { @@ -666,12 +598,11 @@ sub div { sub exit { usage "exit(status)" if @_ != 1; - exit($_[0]); + CORE::exit($_[0]); } sub free { unimpl "free() is C-specific, stopped"; - free($_[0]); } sub getenv { @@ -707,21 +638,9 @@ sub srand { 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 { @@ -734,7 +653,7 @@ sub memcmp { sub memcpy { unimpl "memcpy() is C-specific, use = instead"; - memcpy($_[0]); +} sub memmove { unimpl "memmove() is C-specific, use = instead"; @@ -800,7 +719,7 @@ sub strspn { sub strstr { usage "strstr(big, little)" if @_ != 2; - index($_[0], $_[1]); + CORE::index($_[0], $_[1]); } sub strtok { @@ -808,122 +727,114 @@ 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; } @@ -944,18 +855,18 @@ sub getgid { 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 { @@ -965,7 +876,7 @@ sub getpid { sub getppid { usage "getppid()" if @_ != 0; - getppid; + CORE::getppid; } sub getuid { @@ -980,12 +891,12 @@ sub isatty { 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 { @@ -1000,16 +911,16 @@ sub setuid { 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]); }