ext/POSIX/POSIX.pm

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