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