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