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)],
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
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
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()],
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
}
-bootstrap POSIX;
+bootstrap POSIX $VERSION;
my $EINVAL = constant("EINVAL", 0);
my $EAGAIN = constant("EAGAIN", 0);
local $! = 0;
my $constname = $AUTOLOAD;
$constname =~ s/.*:://;
- my $val = constant($constname, $_[0]);
+ my $val = constant($constname, @_ ? $_[0] : 0);
if ($! == 0) {
*$AUTOLOAD = sub { $val };
}
}
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__
sub opendir {
usage "opendir(directory)" if @_ != 1;
- local($dirhandle) = POSIX->gensym;
+ my $dirhandle = gensym;
opendir($dirhandle, $_[0])
? $dirhandle
: undef;
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()";
+ 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 {
}
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 {
}
sub tmpfile {
- redef "FileHandle::new_tmpfile()";
+ redef "IO::File::new_tmpfile()";
}
sub ungetc {
- redef "FileHandle::ungetc()";
+ redef "IO::Handle::ungetc()";
}
sub vfprintf {
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 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;
}
}
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 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(' ', $) ));
}
projects / p5sagit/p5-mst-13.2.git / blobdiff