ext/POSIX/POSIX.pm

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