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<POSIX.pm> 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)],
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
}
-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]};
-}
-
-############################
-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;
+ bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
}
-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;
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(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 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