[Summary view] [Print] [Text view]

   1  package POSIX;
   2  use strict;
   3  use warnings;
   4  
   5  our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
   6  
   7  our $VERSION = "1.13";
   8  
   9  use AutoLoader;
  10  
  11  use XSLoader ();
  12  
  13  use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
  14           F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
  15           O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
  16           O_WRONLY);
  17  
  18  # Grandfather old foo_h form to new :foo_h form
  19  my $loaded;
  20  
  21  sub import {
  22      load_imports() unless $loaded++;
  23      my $this = shift;
  24      my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
  25      local $Exporter::ExportLevel = 1;
  26      Exporter::import($this,@list);
  27  }
  28  
  29  sub croak { require Carp;  goto &Carp::croak }
  30  # declare usage to assist AutoLoad
  31  sub usage;
  32  
  33  XSLoader::load 'POSIX', $VERSION;
  34  
  35  my %NON_CONSTS = (map {($_,1)}
  36                    qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS
  37                       WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
  38  
  39  sub AUTOLOAD {
  40      no strict;
  41      no warnings 'uninitialized';
  42      if ($AUTOLOAD =~ /::(_?[a-z])/) {
  43      # require AutoLoader;
  44      $AutoLoader::AUTOLOAD = $AUTOLOAD;
  45      goto &AutoLoader::AUTOLOAD
  46      }
  47      local $! = 0;
  48      my $constname = $AUTOLOAD;
  49      $constname =~ s/.*:://;
  50      if ($NON_CONSTS{$constname}) {
  51          my ($val, $error) = &int_macro_int($constname, $_[0]);
  52          croak $error if $error;
  53          *$AUTOLOAD = sub { &int_macro_int($constname, $_[0]) };
  54      } else {
  55          my ($error, $val) = constant($constname);
  56          croak $error if $error;
  57      *$AUTOLOAD = sub { $val };
  58      }
  59  
  60      goto &$AUTOLOAD;
  61  }
  62  
  63  package POSIX::SigAction;
  64  
  65  use AutoLoader 'AUTOLOAD';
  66  
  67  package POSIX::SigRt;
  68  
  69  use AutoLoader 'AUTOLOAD';
  70  
  71  use Tie::Hash;
  72  
  73  use vars qw($SIGACTION_FLAGS $_SIGRTMIN $_SIGRTMAX $_sigrtn @ISA);
  74  @POSIX::SigRt::ISA = qw(Tie::StdHash);
  75  
  76  $SIGACTION_FLAGS = 0;
  77  
  78  tie %POSIX::SIGRT, 'POSIX::SigRt';
  79  
  80  sub DESTROY {};
  81  
  82  package POSIX;
  83  
  84  1;
  85  __END__
  86  
  87  sub usage {
  88      my ($mess) = @_;
  89      croak "Usage: POSIX::$mess";
  90  }
  91  
  92  sub redef {
  93      my ($mess) = @_;
  94      croak "Use method $mess instead";
  95  }
  96  
  97  sub unimpl {
  98      my ($mess) = @_;
  99      $mess =~ s/xxx//;
 100      croak "Unimplemented: POSIX::$mess";
 101  }
 102  
 103  sub assert {
 104      usage "assert(expr)" if @_ != 1;
 105      if (!$_[0]) {
 106      croak "Assertion failed";
 107      }
 108  }
 109  
 110  sub tolower {
 111      usage "tolower(string)" if @_ != 1;
 112      lc($_[0]);
 113  }
 114  
 115  sub toupper {
 116      usage "toupper(string)" if @_ != 1;
 117      uc($_[0]);
 118  }
 119  
 120  sub closedir {
 121      usage "closedir(dirhandle)" if @_ != 1;
 122      CORE::closedir($_[0]);
 123  }
 124  
 125  sub opendir {
 126      usage "opendir(directory)" if @_ != 1;
 127      my $dirhandle;
 128      CORE::opendir($dirhandle, $_[0])
 129      ? $dirhandle
 130      : undef;
 131  }
 132  
 133  sub readdir {
 134      usage "readdir(dirhandle)" if @_ != 1;
 135      CORE::readdir($_[0]);
 136  }
 137  
 138  sub rewinddir {
 139      usage "rewinddir(dirhandle)" if @_ != 1;
 140      CORE::rewinddir($_[0]);
 141  }
 142  
 143  sub errno {
 144      usage "errno()" if @_ != 0;
 145      $! + 0;
 146  }
 147  
 148  sub creat {
 149      usage "creat(filename, mode)" if @_ != 2;
 150      &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
 151  }
 152  
 153  sub fcntl {
 154      usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
 155      CORE::fcntl($_[0], $_[1], $_[2]);
 156  }
 157  
 158  sub getgrgid {
 159      usage "getgrgid(gid)" if @_ != 1;
 160      CORE::getgrgid($_[0]);
 161  }
 162  
 163  sub getgrnam {
 164      usage "getgrnam(name)" if @_ != 1;
 165      CORE::getgrnam($_[0]);
 166  }
 167  
 168  sub atan2 {
 169      usage "atan2(x,y)" if @_ != 2;
 170      CORE::atan2($_[0], $_[1]);
 171  }
 172  
 173  sub cos {
 174      usage "cos(x)" if @_ != 1;
 175      CORE::cos($_[0]);
 176  }
 177  
 178  sub exp {
 179      usage "exp(x)" if @_ != 1;
 180      CORE::exp($_[0]);
 181  }
 182  
 183  sub fabs {
 184      usage "fabs(x)" if @_ != 1;
 185      CORE::abs($_[0]);
 186  }
 187  
 188  sub log {
 189      usage "log(x)" if @_ != 1;
 190      CORE::log($_[0]);
 191  }
 192  
 193  sub pow {
 194      usage "pow(x,exponent)" if @_ != 2;
 195      $_[0] ** $_[1];
 196  }
 197  
 198  sub sin {
 199      usage "sin(x)" if @_ != 1;
 200      CORE::sin($_[0]);
 201  }
 202  
 203  sub sqrt {
 204      usage "sqrt(x)" if @_ != 1;
 205      CORE::sqrt($_[0]);
 206  }
 207  
 208  sub getpwnam {
 209      usage "getpwnam(name)" if @_ != 1;
 210      CORE::getpwnam($_[0]);
 211  }
 212  
 213  sub getpwuid {
 214      usage "getpwuid(uid)" if @_ != 1;
 215      CORE::getpwuid($_[0]);
 216  }
 217  
 218  sub longjmp {
 219      unimpl "longjmp() is C-specific: use die instead";
 220  }
 221  
 222  sub setjmp {
 223      unimpl "setjmp() is C-specific: use eval {} instead";
 224  }
 225  
 226  sub siglongjmp {
 227      unimpl "siglongjmp() is C-specific: use die instead";
 228  }
 229  
 230  sub sigsetjmp {
 231      unimpl "sigsetjmp() is C-specific: use eval {} instead";
 232  }
 233  
 234  sub kill {
 235      usage "kill(pid, sig)" if @_ != 2;
 236      CORE::kill $_[1], $_[0];
 237  }
 238  
 239  sub raise {
 240      usage "raise(sig)" if @_ != 1;
 241      CORE::kill $_[0], $$;    # Is this good enough?
 242  }
 243  
 244  sub offsetof {
 245      unimpl "offsetof() is C-specific, stopped";
 246  }
 247  
 248  sub clearerr {
 249      redef "IO::Handle::clearerr()";
 250  }
 251  
 252  sub fclose {
 253      redef "IO::Handle::close()";
 254  }
 255  
 256  sub fdopen {
 257      redef "IO::Handle::new_from_fd()";
 258  }
 259  
 260  sub feof {
 261      redef "IO::Handle::eof()";
 262  }
 263  
 264  sub fgetc {
 265      redef "IO::Handle::getc()";
 266  }
 267  
 268  sub fgets {
 269      redef "IO::Handle::gets()";
 270  }
 271  
 272  sub fileno {
 273      redef "IO::Handle::fileno()";
 274  }
 275  
 276  sub fopen {
 277      redef "IO::File::open()";
 278  }
 279  
 280  sub fprintf {
 281      unimpl "fprintf() is C-specific--use printf instead";
 282  }
 283  
 284  sub fputc {
 285      unimpl "fputc() is C-specific--use print instead";
 286  }
 287  
 288  sub fputs {
 289      unimpl "fputs() is C-specific--use print instead";
 290  }
 291  
 292  sub fread {
 293      unimpl "fread() is C-specific--use read instead";
 294  }
 295  
 296  sub freopen {
 297      unimpl "freopen() is C-specific--use open instead";
 298  }
 299  
 300  sub fscanf {
 301      unimpl "fscanf() is C-specific--use <> and regular expressions instead";
 302  }
 303  
 304  sub fseek {
 305      redef "IO::Seekable::seek()";
 306  }
 307  
 308  sub fsync {
 309      redef "IO::Handle::sync()";
 310  }
 311  
 312  sub ferror {
 313      redef "IO::Handle::error()";
 314  }
 315  
 316  sub fflush {
 317      redef "IO::Handle::flush()";
 318  }
 319  
 320  sub fgetpos {
 321      redef "IO::Seekable::getpos()";
 322  }
 323  
 324  sub fsetpos {
 325      redef "IO::Seekable::setpos()";
 326  }
 327  
 328  sub ftell {
 329      redef "IO::Seekable::tell()";
 330  }
 331  
 332  sub fwrite {
 333      unimpl "fwrite() is C-specific--use print instead";
 334  }
 335  
 336  sub getc {
 337      usage "getc(handle)" if @_ != 1;
 338      CORE::getc($_[0]);
 339  }
 340  
 341  sub getchar {
 342      usage "getchar()" if @_ != 0;
 343      CORE::getc(STDIN);
 344  }
 345  
 346  sub gets {
 347      usage "gets()" if @_ != 0;
 348      scalar <STDIN>;
 349  }
 350  
 351  sub perror {
 352      print STDERR "@_: " if @_;
 353      print STDERR $!,"\n";
 354  }
 355  
 356  sub printf {
 357      usage "printf(pattern, args...)" if @_ < 1;
 358      CORE::printf STDOUT @_;
 359  }
 360  
 361  sub putc {
 362      unimpl "putc() is C-specific--use print instead";
 363  }
 364  
 365  sub putchar {
 366      unimpl "putchar() is C-specific--use print instead";
 367  }
 368  
 369  sub puts {
 370      unimpl "puts() is C-specific--use print instead";
 371  }
 372  
 373  sub remove {
 374      usage "remove(filename)" if @_ != 1;
 375      (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]);
 376  }
 377  
 378  sub rename {
 379      usage "rename(oldfilename, newfilename)" if @_ != 2;
 380      CORE::rename($_[0], $_[1]);
 381  }
 382  
 383  sub rewind {
 384      usage "rewind(filehandle)" if @_ != 1;
 385      CORE::seek($_[0],0,0);
 386  }
 387  
 388  sub scanf {
 389      unimpl "scanf() is C-specific--use <> and regular expressions instead";
 390  }
 391  
 392  sub sprintf {
 393      usage "sprintf(pattern,args)" if @_ == 0;
 394      CORE::sprintf(shift,@_);
 395  }
 396  
 397  sub sscanf {
 398      unimpl "sscanf() is C-specific--use regular expressions instead";
 399  }
 400  
 401  sub tmpfile {
 402      redef "IO::File::new_tmpfile()";
 403  }
 404  
 405  sub ungetc {
 406      redef "IO::Handle::ungetc()";
 407  }
 408  
 409  sub vfprintf {
 410      unimpl "vfprintf() is C-specific";
 411  }
 412  
 413  sub vprintf {
 414      unimpl "vprintf() is C-specific";
 415  }
 416  
 417  sub vsprintf {
 418      unimpl "vsprintf() is C-specific";
 419  }
 420  
 421  sub abs {
 422      usage "abs(x)" if @_ != 1;
 423      CORE::abs($_[0]);
 424  }
 425  
 426  sub atexit {
 427      unimpl "atexit() is C-specific: use END {} instead";
 428  }
 429  
 430  sub atof {
 431      unimpl "atof() is C-specific, stopped";
 432  }
 433  
 434  sub atoi {
 435      unimpl "atoi() is C-specific, stopped";
 436  }
 437  
 438  sub atol {
 439      unimpl "atol() is C-specific, stopped";
 440  }
 441  
 442  sub bsearch {
 443      unimpl "bsearch() not supplied";
 444  }
 445  
 446  sub calloc {
 447      unimpl "calloc() is C-specific, stopped";
 448  }
 449  
 450  sub div {
 451      unimpl "div() is C-specific, use /, % and int instead";
 452  }
 453  
 454  sub exit {
 455      usage "exit(status)" if @_ != 1;
 456      CORE::exit($_[0]);
 457  }
 458  
 459  sub free {
 460      unimpl "free() is C-specific, stopped";
 461  }
 462  
 463  sub getenv {
 464      usage "getenv(name)" if @_ != 1;
 465      $ENV{$_[0]};
 466  }
 467  
 468  sub labs {
 469      unimpl "labs() is C-specific, use abs instead";
 470  }
 471  
 472  sub ldiv {
 473      unimpl "ldiv() is C-specific, use /, % and int instead";
 474  }
 475  
 476  sub malloc {
 477      unimpl "malloc() is C-specific, stopped";
 478  }
 479  
 480  sub qsort {
 481      unimpl "qsort() is C-specific, use sort instead";
 482  }
 483  
 484  sub rand {
 485      unimpl "rand() is non-portable, use Perl's rand instead";
 486  }
 487  
 488  sub realloc {
 489      unimpl "realloc() is C-specific, stopped";
 490  }
 491  
 492  sub srand {
 493      unimpl "srand()";
 494  }
 495  
 496  sub system {
 497      usage "system(command)" if @_ != 1;
 498      CORE::system($_[0]);
 499  }
 500  
 501  sub memchr {
 502      unimpl "memchr() is C-specific, use index() instead";
 503  }
 504  
 505  sub memcmp {
 506      unimpl "memcmp() is C-specific, use eq instead";
 507  }
 508  
 509  sub memcpy {
 510      unimpl "memcpy() is C-specific, use = instead";
 511  }
 512  
 513  sub memmove {
 514      unimpl "memmove() is C-specific, use = instead";
 515  }
 516  
 517  sub memset {
 518      unimpl "memset() is C-specific, use x instead";
 519  }
 520  
 521  sub strcat {
 522      unimpl "strcat() is C-specific, use .= instead";
 523  }
 524  
 525  sub strchr {
 526      unimpl "strchr() is C-specific, use index() instead";
 527  }
 528  
 529  sub strcmp {
 530      unimpl "strcmp() is C-specific, use eq instead";
 531  }
 532  
 533  sub strcpy {
 534      unimpl "strcpy() is C-specific, use = instead";
 535  }
 536  
 537  sub strcspn {
 538      unimpl "strcspn() is C-specific, use regular expressions instead";
 539  }
 540  
 541  sub strerror {
 542      usage "strerror(errno)" if @_ != 1;
 543      local $! = $_[0];
 544      $! . "";
 545  }
 546  
 547  sub strlen {
 548      unimpl "strlen() is C-specific, use length instead";
 549  }
 550  
 551  sub strncat {
 552      unimpl "strncat() is C-specific, use .= instead";
 553  }
 554  
 555  sub strncmp {
 556      unimpl "strncmp() is C-specific, use eq instead";
 557  }
 558  
 559  sub strncpy {
 560      unimpl "strncpy() is C-specific, use = instead";
 561  }
 562  
 563  sub strpbrk {
 564      unimpl "strpbrk() is C-specific, stopped";
 565  }
 566  
 567  sub strrchr {
 568      unimpl "strrchr() is C-specific, use rindex() instead";
 569  }
 570  
 571  sub strspn {
 572      unimpl "strspn() is C-specific, stopped";
 573  }
 574  
 575  sub strstr {
 576      usage "strstr(big, little)" if @_ != 2;
 577      CORE::index($_[0], $_[1]);
 578  }
 579  
 580  sub strtok {
 581      unimpl "strtok() is C-specific, stopped";
 582  }
 583  
 584  sub chmod {
 585      usage "chmod(mode, filename)" if @_ != 2;
 586      CORE::chmod($_[0], $_[1]);
 587  }
 588  
 589  sub fstat {
 590      usage "fstat(fd)" if @_ != 1;
 591      local *TMP;
 592      CORE::open(TMP, "<&$_[0]");        # Gross.
 593      my @l = CORE::stat(TMP);
 594      CORE::close(TMP);
 595      @l;
 596  }
 597  
 598  sub mkdir {
 599      usage "mkdir(directoryname, mode)" if @_ != 2;
 600      CORE::mkdir($_[0], $_[1]);
 601  }
 602  
 603  sub stat {
 604      usage "stat(filename)" if @_ != 1;
 605      CORE::stat($_[0]);
 606  }
 607  
 608  sub umask {
 609      usage "umask(mask)" if @_ != 1;
 610      CORE::umask($_[0]);
 611  }
 612  
 613  sub wait {
 614      usage "wait()" if @_ != 0;
 615      CORE::wait();
 616  }
 617  
 618  sub waitpid {
 619      usage "waitpid(pid, options)" if @_ != 2;
 620      CORE::waitpid($_[0], $_[1]);
 621  }
 622  
 623  sub gmtime {
 624      usage "gmtime(time)" if @_ != 1;
 625      CORE::gmtime($_[0]);
 626  }
 627  
 628  sub localtime {
 629      usage "localtime(time)" if @_ != 1;
 630      CORE::localtime($_[0]);
 631  }
 632  
 633  sub time {
 634      usage "time()" if @_ != 0;
 635      CORE::time;
 636  }
 637  
 638  sub alarm {
 639      usage "alarm(seconds)" if @_ != 1;
 640      CORE::alarm($_[0]);
 641  }
 642  
 643  sub chdir {
 644      usage "chdir(directory)" if @_ != 1;
 645      CORE::chdir($_[0]);
 646  }
 647  
 648  sub chown {
 649      usage "chown(uid, gid, filename)" if @_ != 3;
 650      CORE::chown($_[0], $_[1], $_[2]);
 651  }
 652  
 653  sub execl {
 654      unimpl "execl() is C-specific, stopped";
 655  }
 656  
 657  sub execle {
 658      unimpl "execle() is C-specific, stopped";
 659  }
 660  
 661  sub execlp {
 662      unimpl "execlp() is C-specific, stopped";
 663  }
 664  
 665  sub execv {
 666      unimpl "execv() is C-specific, stopped";
 667  }
 668  
 669  sub execve {
 670      unimpl "execve() is C-specific, stopped";
 671  }
 672  
 673  sub execvp {
 674      unimpl "execvp() is C-specific, stopped";
 675  }
 676  
 677  sub fork {
 678      usage "fork()" if @_ != 0;
 679      CORE::fork;
 680  }
 681  
 682  sub getegid {
 683      usage "getegid()" if @_ != 0;
 684      $) + 0;
 685  }
 686  
 687  sub geteuid {
 688      usage "geteuid()" if @_ != 0;
 689      $> + 0;
 690  }
 691  
 692  sub getgid {
 693      usage "getgid()" if @_ != 0;
 694      $( + 0;
 695  }
 696  
 697  sub getgroups {
 698      usage "getgroups()" if @_ != 0;
 699      my %seen;
 700      grep(!$seen{$_}++, split(' ', $) ));
 701  }
 702  
 703  sub getlogin {
 704      usage "getlogin()" if @_ != 0;
 705      CORE::getlogin();
 706  }
 707  
 708  sub getpgrp {
 709      usage "getpgrp()" if @_ != 0;
 710      CORE::getpgrp;
 711  }
 712  
 713  sub getpid {
 714      usage "getpid()" if @_ != 0;
 715      $$;
 716  }
 717  
 718  sub getppid {
 719      usage "getppid()" if @_ != 0;
 720      CORE::getppid;
 721  }
 722  
 723  sub getuid {
 724      usage "getuid()" if @_ != 0;
 725      $<;
 726  }
 727  
 728  sub isatty {
 729      usage "isatty(filehandle)" if @_ != 1;
 730      -t $_[0];
 731  }
 732  
 733  sub link {
 734      usage "link(oldfilename, newfilename)" if @_ != 2;
 735      CORE::link($_[0], $_[1]);
 736  }
 737  
 738  sub rmdir {
 739      usage "rmdir(directoryname)" if @_ != 1;
 740      CORE::rmdir($_[0]);
 741  }
 742  
 743  sub setbuf {
 744      redef "IO::Handle::setbuf()";
 745  }
 746  
 747  sub setvbuf {
 748      redef "IO::Handle::setvbuf()";
 749  }
 750  
 751  sub sleep {
 752      usage "sleep(seconds)" if @_ != 1;
 753      $_[0] - CORE::sleep($_[0]);
 754  }
 755  
 756  sub unlink {
 757      usage "unlink(filename)" if @_ != 1;
 758      CORE::unlink($_[0]);
 759  }
 760  
 761  sub utime {
 762      usage "utime(filename, atime, mtime)" if @_ != 3;
 763      CORE::utime($_[1], $_[2], $_[0]);
 764  }
 765  
 766  sub load_imports {
 767  %EXPORT_TAGS = (
 768  
 769      assert_h =>    [qw(assert NDEBUG)],
 770  
 771      ctype_h =>    [qw(isalnum isalpha iscntrl isdigit isgraph islower
 772          isprint ispunct isspace isupper isxdigit tolower toupper)],
 773  
 774      dirent_h =>    [],
 775  
 776      errno_h =>    [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
 777          EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
 778          ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
 779          EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
 780          EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
 781          EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
 782          ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
 783          ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
 784          ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
 785          EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
 786          ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
 787          ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
 788          EUSERS EWOULDBLOCK EXDEV errno)],
 789  
 790      fcntl_h =>    [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
 791          F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
 792          O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
 793          O_RDONLY O_RDWR O_TRUNC O_WRONLY
 794          creat
 795          SEEK_CUR SEEK_END SEEK_SET
 796          S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
 797          S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
 798          S_IWGRP S_IWOTH S_IWUSR)],
 799  
 800      float_h =>    [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
 801          DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
 802          DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
 803          FLT_DIG FLT_EPSILON FLT_MANT_DIG
 804          FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
 805          FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
 806          FLT_RADIX FLT_ROUNDS
 807          LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
 808          LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
 809          LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
 810  
 811      grp_h =>    [],
 812  
 813      limits_h =>    [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
 814          INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
 815          MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
 816          PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
 817          SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
 818          ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
 819          _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
 820          _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
 821          _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
 822          _POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
 823  
 824      locale_h =>    [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES
 825              LC_MONETARY LC_NUMERIC LC_TIME NULL
 826              localeconv setlocale)],
 827  
 828      math_h =>    [qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
 829          frexp ldexp log10 modf pow sinh tan tanh)],
 830  
 831      pwd_h =>    [],
 832  
 833      setjmp_h =>    [qw(longjmp setjmp siglongjmp sigsetjmp)],
 834  
 835      signal_h =>    [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
 836          SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
 837          SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
 838          SIGPIPE %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP
 839          SIGTERM SIGTSTP SIGTTIN    SIGTTOU SIGUSR1 SIGUSR2
 840          SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
 841          raise sigaction signal sigpending sigprocmask sigsuspend)],
 842  
 843      stdarg_h =>    [],
 844  
 845      stddef_h =>    [qw(NULL offsetof)],
 846  
 847      stdio_h =>    [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
 848          L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
 849          STREAM_MAX TMP_MAX stderr stdin stdout
 850          clearerr fclose fdopen feof ferror fflush fgetc fgetpos
 851          fgets fopen fprintf fputc fputs fread freopen
 852          fscanf fseek fsetpos ftell fwrite getchar gets
 853          perror putc putchar puts remove rewind
 854          scanf setbuf setvbuf sscanf tmpfile tmpnam
 855          ungetc vfprintf vprintf vsprintf)],
 856  
 857      stdlib_h =>    [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
 858          abort atexit atof atoi atol bsearch calloc div
 859          free getenv labs ldiv malloc mblen mbstowcs mbtowc
 860          qsort realloc strtod strtol strtoul wcstombs wctomb)],
 861  
 862      string_h =>    [qw(NULL memchr memcmp memcpy memmove memset strcat
 863          strchr strcmp strcoll strcpy strcspn strerror strlen
 864          strncat strncmp strncpy strpbrk strrchr strspn strstr
 865          strtok strxfrm)],
 866  
 867      sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
 868          S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
 869          S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
 870          fstat mkfifo)],
 871  
 872      sys_times_h => [],
 873  
 874      sys_types_h => [],
 875  
 876      sys_utsname_h => [qw(uname)],
 877  
 878      sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
 879          WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
 880  
 881      termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
 882          B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
 883          CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
 884          ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
 885          INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
 886          PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
 887          TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
 888          TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
 889          VSTOP VSUSP VTIME
 890          cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
 891          tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
 892  
 893      time_h =>    [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
 894          difftime mktime strftime tzset tzname)],
 895  
 896      unistd_h =>    [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
 897          STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
 898          _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
 899          _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
 900          _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
 901          _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
 902          _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
 903          _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
 904          _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
 905          _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
 906          _exit access ctermid cuserid
 907          dup2 dup execl execle execlp execv execve execvp
 908          fpathconf fsync getcwd getegid geteuid getgid getgroups
 909          getpid getuid isatty lseek pathconf pause setgid setpgid
 910          setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
 911  
 912      utime_h =>    [],
 913  
 914  );
 915  
 916  # Exporter::export_tags();
 917  {
 918    # De-duplicate the export list: 
 919    my %export;
 920    @export{map {@$_} values %EXPORT_TAGS} = ();
 921    # Doing the de-dup with a temporary hash has the advantage that the SVs in
 922    # @EXPORT are actually shared hash key sacalars, which will save some memory.
 923    push @EXPORT, keys %export;
 924  }
 925  
 926  @EXPORT_OK = qw(
 927          abs
 928          alarm
 929          atan2
 930          chdir
 931          chmod
 932          chown
 933          close
 934          closedir
 935          cos
 936          exit
 937          exp
 938          fcntl
 939          fileno
 940          fork
 941          getc
 942          getgrgid
 943          getgrnam
 944          getlogin
 945          getpgrp
 946          getppid
 947          getpwnam
 948          getpwuid
 949          gmtime
 950          isatty
 951          kill
 952          lchown
 953          link
 954          localtime
 955          log
 956          mkdir
 957          nice
 958          open
 959          opendir
 960          pipe
 961          printf
 962          rand
 963          read
 964          readdir
 965          rename
 966          rewinddir
 967          rmdir
 968          sin
 969          sleep
 970          sprintf
 971          sqrt
 972          srand
 973          stat
 974          system
 975          time
 976          times
 977          umask
 978          unlink
 979          utime
 980          wait
 981          waitpid
 982          write
 983  );
 984  
 985  require Exporter;
 986  }
 987  
 988  package POSIX::SigAction;
 989  
 990  sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] }
 991  sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} };
 992  sub mask    { $_[0]->{MASK}    = $_[1] if @_ > 1; $_[0]->{MASK} };
 993  sub flags   { $_[0]->{FLAGS}   = $_[1] if @_ > 1; $_[0]->{FLAGS} };
 994  sub safe    { $_[0]->{SAFE}    = $_[1] if @_ > 1; $_[0]->{SAFE} };
 995  
 996  package POSIX::SigRt;
 997  
 998  
 999  sub _init {
1000      $_SIGRTMIN = &POSIX::SIGRTMIN;
1001      $_SIGRTMAX = &POSIX::SIGRTMAX;
1002      $_sigrtn   = $_SIGRTMAX - $_SIGRTMIN;
1003  }
1004  
1005  sub _croak {
1006      &_init unless defined $_sigrtn;
1007      die "POSIX::SigRt not available" unless defined $_sigrtn && $_sigrtn > 0;
1008  }
1009  
1010  sub _getsig {
1011      &_croak;
1012      my $rtsig = $_[0];
1013      # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C.
1014      $rtsig = $_SIGRTMIN + ($1 || 0)
1015      if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/;
1016      return $rtsig;
1017  }
1018  
1019  sub _exist {
1020      my $rtsig = _getsig($_[1]);
1021      my $ok    = $rtsig >= $_SIGRTMIN && $rtsig <= $_SIGRTMAX;
1022      ($rtsig, $ok);
1023  }
1024  
1025  sub _check {
1026      my ($rtsig, $ok) = &_exist;
1027      die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $_SIGRTMIN..$_SIGRTMAX)"
1028      unless $ok;
1029      return $rtsig;
1030  }
1031  
1032  sub new {
1033      my ($rtsig, $handler, $flags) = @_;
1034      my $sigset = POSIX::SigSet->new($rtsig);
1035      my $sigact = POSIX::SigAction->new($handler,
1036                         $sigset,
1037                         $flags);
1038      POSIX::sigaction($rtsig, $sigact);
1039  }
1040  
1041  sub EXISTS { &_exist }
1042  sub FETCH  { my $rtsig = &_check;
1043           my $oa = POSIX::SigAction->new();
1044           POSIX::sigaction($rtsig, undef, $oa);
1045           return $oa->{HANDLER} }
1046  sub STORE  { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) }
1047  sub DELETE { delete $SIG{ &_check } }
1048  sub CLEAR  { &_exist; delete @SIG{ &POSIX::SIGRTMIN .. &POSIX::SIGRTMAX } }
1049  sub SCALAR { &_croak; $_sigrtn + 1 }