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