X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.pm;h=b95249ce43659288c4d70ac4504ea7499d6968e7;hb=276493cb78ba879defeed992c4543a6fe30f98ce;hp=2c397bb5ab22b65ef1e2d815bb3b89e8e6e10226;hpb=3712091946b37b5feabcc1f630b32639406ad717;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 2c397bb..b95249c 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; -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)], @@ -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 @@ -66,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 @@ -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 @@ -100,7 +115,7 @@ require Config; 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)], + fstat mkfifo mknod)], sys_times_h => [qw()], @@ -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 @@ -175,7 +191,7 @@ sub import { } -bootstrap POSIX; +bootstrap POSIX $VERSION; my $EINVAL = constant("EINVAL", 0); my $EAGAIN = constant("EAGAIN", 0); @@ -188,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 }; } @@ -206,107 +222,29 @@ 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]}; + 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($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]); -} - -sub tell { - POSIX::usage "tell(filehandle)" if @_ != 1; - tell($_[0]); -} -############################ package POSIX; # return to package POSIX so AutoSplit is happy 1; __END__ @@ -335,7 +273,7 @@ sub closedir { sub opendir { usage "opendir(directory)" if @_ != 1; - local($dirhandle) = POSIX->gensym; + my $dirhandle = gensym; opendir($dirhandle, $_[0]) ? $dirhandle : undef; @@ -449,7 +387,7 @@ sub kill { sub raise { usage "raise(sig)" if @_ != 1; - kill $$, $_[0]; # Is this good enough? + kill $_[0], $$; # Is this good enough? } sub offsetof { @@ -457,35 +395,35 @@ sub offsetof { } sub clearerr { - redef "FileHandle::clearerr()"; + redef "IO::Handle::clearerr()"; } sub fclose { - redef "FileHandle::close()"; + redef "IO::Handle::close()"; } sub fdopen { - redef "FileHandle::new_from_fd()"; + 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 { @@ -513,27 +451,27 @@ sub fscanf { } sub fseek { - redef "FileHandle::seek()"; + 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()"; + redef "IO::Seekable::setpos()"; } sub ftell { - redef "FileHandle::tell()"; + redef "IO::Seekable::tell()"; } sub fwrite { @@ -606,11 +544,11 @@ sub sscanf { } sub tmpfile { - redef "FileHandle::new_tmpfile()"; + redef "IO::File::new_tmpfile()"; } sub ungetc { - redef "FileHandle::ungetc()"; + redef "IO::Handle::ungetc()"; } sub vfprintf { @@ -700,18 +638,6 @@ 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]); @@ -807,9 +733,9 @@ sub chmod { 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; } @@ -830,17 +756,13 @@ sub umask { } 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 { @@ -905,7 +827,14 @@ sub 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; } @@ -926,7 +855,7 @@ sub getgid { sub getgroups { usage "getgroups()" if @_ != 0; - local(%seen) = (); + my %seen; grep(!$seen{$_}++, split(' ', $) )); }