X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.pm;h=74a014fb431f38c58440d91bf87458b9f18f51a0;hb=463d09e6aae174eaf79dbe628f27cb752bc2f77b;hp=918b2a0c6bb29c194d558f0a9f362ff6ef1fb8ae;hpb=b5846a0b04f865340214f384842c67c721c12992;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 918b2a0..74a014f 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -6,7 +6,7 @@ use AutoLoader; use XSLoader (); -our $VERSION = "1.04" ; +our $VERSION = "1.05" ; # Grandfather old foo_h form to new :foo_h form my $loaded; @@ -20,11 +20,14 @@ sub import { } sub croak { require Carp; goto &Carp::croak } +# declare usage to assist AutoLoad +sub usage; XSLoader::load 'POSIX', $VERSION; -my $EINVAL = constant("EINVAL", 0); -my $EAGAIN = constant("EAGAIN", 0); +my %NON_CONSTS = (map {($_,1)} + qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS + WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG)); sub AUTOLOAD { if ($AUTOLOAD =~ /::(_?[a-z])/) { @@ -35,51 +38,45 @@ sub AUTOLOAD { local $! = 0; my $constname = $AUTOLOAD; $constname =~ s/.*:://; - my $val = constant($constname, @_ ? $_[0] : 0); - if ($! == 0) { + if ($NON_CONSTS{$constname}) { + my ($val, $error) = &int_macro_int($constname, $_[0]); + croak $error if $error; + *$AUTOLOAD = sub { &int_macro_int($constname, $_[0]) }; + } else { + my ($error, $val) = constant($constname); + croak $error if $error; *$AUTOLOAD = sub { $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; } -sub usage { +package POSIX::SigAction; + +use AutoLoader 'AUTOLOAD'; +sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0] } + +package POSIX; + +1; +__END__ + +sub usage { my ($mess) = @_; croak "Usage: POSIX::$mess"; } -sub redef { +sub redef { my ($mess) = @_; croak "Use method $mess instead"; } -sub unimpl { +sub unimpl { my ($mess) = @_; $mess =~ s/xxx//; croak "Unimplemented: POSIX::$mess"; } -############################ -package POSIX::SigAction; - -sub new { - bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0]; -} - -############################ -package POSIX; # return to package POSIX so AutoSplit is happy -1; -__END__ - sub assert { usage "assert(expr)" if @_ != 1; if (!$_[0]) { @@ -285,6 +282,10 @@ sub fseek { redef "IO::Seekable::seek()"; } +sub fsync { + redef "IO::Handle::sync()"; +} + sub ferror { redef "IO::Handle::error()"; } @@ -726,7 +727,7 @@ sub setvbuf { sub sleep { usage "sleep(seconds)" if @_ != 1; - CORE::sleep($_[0]); + $_[0] - CORE::sleep($_[0]); } sub unlink { @@ -747,7 +748,7 @@ sub load_imports { ctype_h => [qw(isalnum isalpha iscntrl isdigit isgraph islower isprint ispunct isspace isupper isxdigit tolower toupper)], - dirent_h => [qw()], + dirent_h => [], errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED @@ -784,7 +785,7 @@ sub load_imports { LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)], - grp_h => [qw()], + grp_h => [], limits_h => [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON @@ -797,13 +798,14 @@ sub load_imports { _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_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)], + locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES + 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 tan tanh)], - pwd_h => [qw()], + pwd_h => [], setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)], @@ -815,7 +817,7 @@ sub load_imports { SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal sigpending sigprocmask sigsuspend)], - stdarg_h => [qw()], + stdarg_h => [], stddef_h => [qw(NULL offsetof)], @@ -844,9 +846,9 @@ sub load_imports { S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR fstat mkfifo)], - sys_times_h => [qw()], + sys_times_h => [], - sys_types_h => [qw()], + sys_types_h => [], sys_utsname_h => [qw(uname)], @@ -876,15 +878,15 @@ sub load_imports { _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL - _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS + _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION _exit access ctermid cuserid dup2 dup execl execle execlp execv execve execvp - fpathconf getcwd getegid geteuid getgid getgroups + fpathconf fsync getcwd getegid geteuid getgid getgroups getpid getuid isatty lseek pathconf pause setgid setpgid setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)], - utime_h => [qw()], + utime_h => [], ); @@ -894,23 +896,68 @@ for (values %EXPORT_TAGS) { } @EXPORT_OK = qw( - closedir opendir readdir rewinddir - fcntl open - getgrgid getgrnam - atan2 cos exp log sin sqrt - getpwnam getpwuid - kill - fileno getc printf rename sprintf - abs exit rand srand system - chmod mkdir stat umask - times - wait waitpid - gmtime localtime time - alarm chdir chown close fork getlogin getppid getpgrp link - pipe read rmdir sleep unlink write - utime - nice + abs + alarm + atan2 + chdir + chmod + chown + close + closedir + cos + exit + exp + fcntl + fileno + fork + getc + getgrgid + getgrnam + getlogin + getpgrp + getppid + getpwnam + getpwuid + gmtime + isatty + kill + link + localtime + log + mkdir + nice + open + opendir + pipe + printf + rand + read + readdir + rename + rewinddir + rmdir + sin + sleep + sprintf + sqrt + srand + stat + system + time + times + umask + unlink + utime + wait + waitpid + write ); require Exporter; } + +package POSIX::SigAction; + +sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} }; +sub mask { $_[0]->{MASK} = $_[1] if @_ > 1; $_[0]->{MASK} }; +sub flags { $_[0]->{FLAGS} = $_[1] if @_ > 1; $_[0]->{FLAGS} };