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