X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.pm;h=76455f70dd073f7ead63e62d47083405a418159b;hb=5507c093461a5bb63a4cc7e16e5a935c61c49879;hp=0a3eb82f8e38148a06ed42f8509560fb46221018;hpb=4633a7c4bad06b471d9310620b7fe8ddd158cccd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 0a3eb82..76455f7 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -1,68 +1,18 @@ package POSIX; -=head1 NAME - -POSIX - Perl interface to IEEE 1003.1 namespace - -=head1 SYNOPSIS - - use POSIX; - use POSIX 'strftime'; - -=head1 DESCRIPTION - -The POSIX module permits you to access all (or nearly all) the standard -POSIX 1003.1 identifiers. Things which are C<#defines> in C, like EINTR -or O_NDELAY, are automatically exported into your namespace. All -functions are only exported if you ask for them explicitly. Most likely -people will prefer to use the fully-qualified function names. - -To get a list of all the possible identifiers available to you--and -their semantics--you should pick up a 1003.1 spec, or look in the -F module. - -=head1 EXAMPLES - - printf "EINTR is %d\n", EINTR; - - POSIX::setsid(0); - - $fd = POSIX::open($path, O_CREAT|O_EXCL|O_WRONLY, 0644); - # note: that's a filedescriptor, *NOT* a filehandle - -=head1 NOTE - -The POSIX module is probably the most complex Perl module supplied with -the standard distribution. It incorporates autoloading, namespace games, -and dynamic loading of code that's in Perl, C, or both. It's a great -source of wisdom. - -=head1 CAVEATS - -A few functions are not implemented because they are C specific. If you -attempt to call these, they will print a message telling you that they -aren't implemented, and suggest using the Perl equivalent should one -exist. For example, trying to access the setjmp() call will elicit the -message "setjmp() is C-specific: use eval {} instead". - -Furthermore, some evil vendors will claim 1003.1 compliance, but in fact -are not so: they will not pass the PCTS (POSIX Compliance Test Suites). -For example, one vendor may not define EDEADLK, or the semantics of the -errno values set by open(2) might not be quite right. Perl does not -attempt to verify POSIX compliance. That means you can currently -successfully say "use POSIX", and then later in your program you find -that your vendor has been lax and there's no usable ICANON macro after -all. This could be construed to be a bug. - -=cut +use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK $AUTOLOAD); use Carp; -require Exporter; use AutoLoader; -require DynaLoader; require Config; +use Symbol; + +require Exporter; +require DynaLoader; @ISA = qw(Exporter DynaLoader); +$VERSION = "1.02" ; + %EXPORT_TAGS = ( assert_h => [qw(assert NDEBUG)], @@ -72,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 @@ -110,7 +68,7 @@ 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)], @@ -122,20 +80,21 @@ require Config; 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 @@ -146,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 @@ -220,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 @@ -231,7 +191,7 @@ sub import { } -bootstrap POSIX; +bootstrap POSIX $VERSION; my $EINVAL = constant("EINVAL", 0); my $EAGAIN = constant("EAGAIN", 0); @@ -244,7 +204,7 @@ sub AUTOLOAD { local $! = 0; my $constname = $AUTOLOAD; $constname =~ s/.*:://; - my $val = constant($constname, $_[0]); + my $val = constant($constname, @_ ? $_[0] : 0); if ($! == 0) { *$AUTOLOAD = sub { $val }; } @@ -262,106 +222,28 @@ sub AUTOLOAD { } 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"; } -sub gensym { - my $pkg = @_ ? ref($_[0]) || $_[0] : ""; - local *{$pkg . "::GLOB" . ++$seq}; - \delete ${$pkg . "::"}{'GLOB' . $seq}; -} - -sub ungensym { -} - ############################ 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($sym) = $class->POSIX::gensym; - $mode =~ s/a.*/>>/ || - $mode =~ s/w.*/>/ || - ($mode = '<'); - open($sym, "$mode $filename") and - bless $sym => $class; -} - -sub new_from_fd { - POSIX::usage "FileHandle->new_from_fd(fd,mode)" if @_ != 3; - local($class,$fd,$mode) = @_; - local($sym) = $class->POSIX::gensym; - $mode =~ s/a.*/>>/ || - $mode =~ s/w.*/>/ || - ($mode = '<'); - open($sym, "$mode&=$fd") and - bless $sym => $class; -} - -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]); -} - -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]); + bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0]; } -sub tell { - POSIX::usage "tell(filehandle)" if @_ != 1; - tell($_[0]); -} ############################ package POSIX; # return to package POSIX so AutoSplit is happy 1; @@ -386,25 +268,25 @@ sub toupper { sub closedir { usage "closedir(dirhandle)" if @_ != 1; - closedir($_[0]); + CORE::closedir($_[0]); } sub opendir { usage "opendir(directory)" if @_ != 1; - local($dirhandle) = POSIX->gensym; - opendir($dirhandle, $_[0]) + my $dirhandle = gensym; + CORE::opendir($dirhandle, $_[0]) ? $dirhandle : 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 { @@ -419,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 { @@ -464,22 +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]); + 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 { @@ -500,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 { @@ -513,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 { @@ -569,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 { @@ -598,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 { @@ -618,7 +500,7 @@ sub perror { sub printf { usage "printf(pattern, args...)" if @_ < 1; - printf STDOUT @_; + CORE::printf STDOUT @_; } sub putc { @@ -635,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 { @@ -654,7 +536,7 @@ sub scanf { sub sprintf { usage "sprintf(pattern,args)" if @_ == 0; - sprintf(shift,@_); + CORE::sprintf(shift,@_); } sub sscanf { @@ -662,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 { @@ -683,7 +565,7 @@ sub vsprintf { sub abs { usage "abs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub atexit { @@ -703,8 +585,7 @@ sub atol { } sub bsearch { - unimpl "bsearch(xxx)" if @_ != 123; - bsearch($_[0]); + unimpl "bsearch() not supplied"; } sub calloc { @@ -717,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 { @@ -758,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 { @@ -785,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"; @@ -851,7 +719,7 @@ sub strspn { sub strstr { usage "strstr(big, little)" if @_ != 2; - index($_[0], $_[1]); + CORE::index($_[0], $_[1]); } sub strtok { @@ -860,121 +728,113 @@ sub strtok { sub chmod { usage "chmod(mode, filename)" if @_ != 2; - chmod($_[0], $_[1]); + 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; } @@ -995,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 { @@ -1016,7 +876,7 @@ sub getpid { sub getppid { usage "getppid()" if @_ != 0; - getppid; + CORE::getppid; } sub getuid { @@ -1031,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 { @@ -1051,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]); }