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