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