perlio.c

   1 /*    perlio.c
   2  *
   3  *    Copyright (c) 1996, Nick Ing-Simmons
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 #define VOIDUSED 1
  11 #include "config.h"
  12
  13 #define PERLIO_NOT_STDIO 0
  14 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
  15 #define PerlIO FILE
  16 #endif
  17 /*
  18  * This file provides those parts of PerlIO abstraction
  19  * which are not #defined in perlio.h.
  20  * Which these are depends on various Configure #ifdef's
  21  */
  22
  23 #include "EXTERN.h"
  24 #include "perl.h"
  25
  26 #ifdef PERLIO_IS_STDIO
  27
  28 void
  29 PerlIO_init()
  30 {
  31  /* Does nothing (yet) except force this file to be included
  32     in perl binary. That allows this file to force inclusion
  33     of other functions that may be required by loadable
  34     extensions e.g. for FileHandle::tmpfile
  35  */
  36 }
  37
  38 #undef PerlIO_tmpfile
  39 PerlIO *
  40 PerlIO_tmpfile()
  41 {
  42  return tmpfile();
  43 }
  44
  45 #else /* PERLIO_IS_STDIO */
  46
  47 #ifdef USE_SFIO
  48
  49 #undef HAS_FSETPOS
  50 #undef HAS_FGETPOS
  51
  52 /* This section is just to make sure these functions
  53    get pulled in from libsfio.a
  54 */
  55
  56 #undef PerlIO_tmpfile
  57 PerlIO *
  58 PerlIO_tmpfile()
  59 {
  60  return sftmp(0);
  61 }
  62
  63 void
  64 PerlIO_init()
  65 {
  66  /* Force this file to be included  in perl binary. Which allows
  67   *  this file to force inclusion  of other functions that may be
  68   *  required by loadable  extensions e.g. for FileHandle::tmpfile
  69   */
  70
  71  /* Hack
  72   * sfio does its own 'autoflush' on stdout in common cases.
  73   * Flush results in a lot of lseek()s to regular files and
  74   * lot of small writes to pipes.
  75   */
  76  sfset(sfstdout,SF_SHARE,0);
  77 }
  78
  79 #else
  80
  81 /* Implement all the PerlIO interface using stdio.
  82    - this should be only file to include <stdio.h>
  83 */
  84
  85 #undef PerlIO_stderr
  86 PerlIO *
  87 PerlIO_stderr()
  88 {
  89  return (PerlIO *) stderr;
  90 }
  91
  92 #undef PerlIO_stdin
  93 PerlIO *
  94 PerlIO_stdin()
  95 {
  96  return (PerlIO *) stdin;
  97 }
  98
  99 #undef PerlIO_stdout
 100 PerlIO *
 101 PerlIO_stdout()
 102 {
 103  return (PerlIO *) stdout;
 104 }
 105
 106 #ifdef HAS_SETLINEBUF
 107 extern void setlinebuf _((FILE *iop));
 108 #endif
 109
 110 #undef PerlIO_fast_gets
 111 int
 112 PerlIO_fast_gets(f)
 113 PerlIO *f;
 114 {
 115 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
 116  return 1;
 117 #else
 118  return 0;
 119 #endif
 120 }
 121
 122 #undef PerlIO_has_cntptr
 123 int
 124 PerlIO_has_cntptr(f)
 125 PerlIO *f;
 126 {
 127 #if defined(USE_STDIO_PTR)
 128  return 1;
 129 #else
 130  return 0;
 131 #endif
 132 }
 133
 134 #undef PerlIO_canset_cnt
 135 int
 136 PerlIO_canset_cnt(f)
 137 PerlIO *f;
 138 {
 139 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
 140  return 1;
 141 #else
 142  return 0;
 143 #endif
 144 }
 145
 146 #undef PerlIO_set_cnt
 147 void
 148 PerlIO_set_cnt(f,cnt)
 149 PerlIO *f;
 150 int cnt;
 151 {
 152  if (cnt < 0)
 153   warn("Setting cnt to %d\n",cnt);
 154 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
 155  FILE_cnt(f) = cnt;
 156 #else
 157  croak("Cannot set 'cnt' of FILE * on this system");
 158 #endif
 159 }
 160
 161 #undef PerlIO_set_ptrcnt
 162 void
 163 PerlIO_set_ptrcnt(f,ptr,cnt)
 164 PerlIO *f;
 165 char *ptr;
 166 int cnt;
 167 {
 168 #ifdef FILE_bufsiz
 169  char *e = (char *)(FILE_base(f) + FILE_bufsiz(f));
 170  int ec  = e - ptr;
 171  if (ptr > e)
 172   warn("Setting ptr %p > base %p\n",ptr, FILE_base(f)+FILE_bufsiz(f));
 173  if (cnt != ec)
 174   warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
 175 #endif
 176 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
 177  FILE_ptr(f) = (STDCHAR *) ptr;
 178 #else
 179  croak("Cannot set 'ptr' of FILE * on this system");
 180 #endif
 181 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
 182  FILE_cnt(f) = cnt;
 183 #else
 184  croak("Cannot set 'cnt' of FILE * on this system");
 185 #endif
 186 }
 187
 188 #undef PerlIO_get_cnt
 189 int
 190 PerlIO_get_cnt(f)
 191 PerlIO *f;
 192 {
 193 #ifdef FILE_cnt
 194  return FILE_cnt(f);
 195 #else
 196  croak("Cannot get 'cnt' of FILE * on this system");
 197  return -1;
 198 #endif
 199 }
 200
 201 #undef PerlIO_get_bufsiz
 202 int
 203 PerlIO_get_bufsiz(f)
 204 PerlIO *f;
 205 {
 206 #ifdef FILE_bufsiz
 207  return FILE_bufsiz(f);
 208 #else
 209  croak("Cannot get 'bufsiz' of FILE * on this system");
 210  return -1;
 211 #endif
 212 }
 213
 214 #undef PerlIO_get_ptr
 215 char *
 216 PerlIO_get_ptr(f)
 217 PerlIO *f;
 218 {
 219 #ifdef FILE_ptr
 220  return (char *) FILE_ptr(f);
 221 #else
 222  croak("Cannot get 'ptr' of FILE * on this system");
 223  return NULL;
 224 #endif
 225 }
 226
 227 #undef PerlIO_get_base
 228 char *
 229 PerlIO_get_base(f)
 230 PerlIO *f;
 231 {
 232 #ifdef FILE_base
 233  return (char *) FILE_base(f);
 234 #else
 235  croak("Cannot get 'base' of FILE * on this system");
 236  return NULL;
 237 #endif
 238 }
 239
 240 #undef PerlIO_has_base
 241 int
 242 PerlIO_has_base(f)
 243 PerlIO *f;
 244 {
 245 #ifdef FILE_base
 246  return 1;
 247 #else
 248  return 0;
 249 #endif
 250 }
 251
 252 #undef PerlIO_puts
 253 int
 254 PerlIO_puts(f,s)
 255 PerlIO *f;
 256 const char *s;
 257 {
 258  return fputs(s,f);
 259 }
 260
 261 #undef PerlIO_open
 262 PerlIO *
 263 PerlIO_open(path,mode)
 264 const char *path;
 265 const char *mode;
 266 {
 267  return fopen(path,mode);
 268 }
 269
 270 #undef PerlIO_fdopen
 271 PerlIO *
 272 PerlIO_fdopen(fd,mode)
 273 int fd;
 274 const char *mode;
 275 {
 276  return fdopen(fd,mode);
 277 }
 278
 279
 280 #undef PerlIO_close
 281 int
 282 PerlIO_close(f)
 283 PerlIO *f;
 284 {
 285  return fclose(f);
 286 }
 287
 288 #undef PerlIO_eof
 289 int
 290 PerlIO_eof(f)
 291 PerlIO *f;
 292 {
 293  return feof(f);
 294 }
 295
 296 #undef PerlIO_getc
 297 int
 298 PerlIO_getc(f)
 299 PerlIO *f;
 300 {
 301  return fgetc(f);
 302 }
 303
 304 #undef PerlIO_error
 305 int
 306 PerlIO_error(f)
 307 PerlIO *f;
 308 {
 309  return ferror(f);
 310 }
 311
 312 #undef PerlIO_clearerr
 313 void
 314 PerlIO_clearerr(f)
 315 PerlIO *f;
 316 {
 317  clearerr(f);
 318 }
 319
 320 #undef PerlIO_flush
 321 int
 322 PerlIO_flush(f)
 323 PerlIO *f;
 324 {
 325  return Fflush(f);
 326 }
 327
 328 #undef PerlIO_fileno
 329 int
 330 PerlIO_fileno(f)
 331 PerlIO *f;
 332 {
 333  return fileno(f);
 334 }
 335
 336 #undef PerlIO_setlinebuf
 337 void
 338 PerlIO_setlinebuf(f)
 339 PerlIO *f;
 340 {
 341 #ifdef HAS_SETLINEBUF
 342     setlinebuf(f);
 343 #else
 344     setvbuf(f, Nullch, _IOLBF, 0);
 345 #endif
 346 }
 347
 348 #undef PerlIO_putc
 349 int
 350 PerlIO_putc(f,ch)
 351 PerlIO *f;
 352 int ch;
 353 {
 354  putc(ch,f);
 355 }
 356
 357 #undef PerlIO_ungetc
 358 int
 359 PerlIO_ungetc(f,ch)
 360 PerlIO *f;
 361 int ch;
 362 {
 363  ungetc(ch,f);
 364 }
 365
 366 #undef PerlIO_read
 367 int
 368 PerlIO_read(f,buf,count)
 369 PerlIO *f;
 370 void *buf;
 371 size_t count;
 372 {
 373  return fread(buf,1,count,f);
 374 }
 375
 376 #undef PerlIO_write
 377 int
 378 PerlIO_write(f,buf,count)
 379 PerlIO *f;
 380 const void *buf;
 381 size_t count;
 382 {
 383  return fwrite1(buf,1,count,f);
 384 }
 385
 386 #undef PerlIO_vprintf
 387 int
 388 PerlIO_vprintf(f,fmt,ap)
 389 PerlIO *f;
 390 const char *fmt;
 391 va_list ap;
 392 {
 393  return vfprintf(f,fmt,ap);
 394 }
 395
 396
 397 #undef PerlIO_tell
 398 long
 399 PerlIO_tell(f)
 400 PerlIO *f;
 401 {
 402  return ftell(f);
 403 }
 404
 405 #undef PerlIO_seek
 406 int
 407 PerlIO_seek(f,offset,whence)
 408 PerlIO *f;
 409 off_t offset;
 410 int whence;
 411 {
 412  return fseek(f,offset,whence);
 413 }
 414
 415 #undef PerlIO_rewind
 416 void
 417 PerlIO_rewind(f)
 418 PerlIO *f;
 419 {
 420  rewind(f);
 421 }
 422
 423 #undef PerlIO_printf
 424 int
 425 #ifdef I_STDARG
 426 PerlIO_printf(PerlIO *f,const char *fmt,...)
 427 #else
 428 PerlIO_printf(f,fmt,va_alist)
 429 PerlIO *f;
 430 const char *fmt;
 431 va_dcl
 432 #endif
 433 {
 434  va_list ap;
 435  int result;
 436 #ifdef I_STDARG
 437  va_start(ap,fmt);
 438 #else
 439  va_start(ap);
 440 #endif
 441  result = vfprintf(f,fmt,ap);
 442  va_end(ap);
 443  return result;
 444 }
 445
 446 #undef PerlIO_stdoutf
 447 int
 448 #ifdef I_STDARG
 449 PerlIO_stdoutf(const char *fmt,...)
 450 #else
 451 PerlIO_stdoutf(fmt, va_alist)
 452 const char *fmt;
 453 va_dcl
 454 #endif
 455 {
 456  va_list ap;
 457  int result;
 458 #ifdef I_STDARG
 459  va_start(ap,fmt);
 460 #else
 461  va_start(ap);
 462 #endif
 463  result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
 464  va_end(ap);
 465  return result;
 466 }
 467
 468 #undef PerlIO_tmpfile
 469 PerlIO *
 470 PerlIO_tmpfile()
 471 {
 472  return tmpfile();
 473 }
 474
 475 #undef PerlIO_importFILE
 476 PerlIO *
 477 PerlIO_importFILE(f,fl)
 478 FILE *f;
 479 int fl;
 480 {
 481  return f;
 482 }
 483
 484 #undef PerlIO_exportFILE
 485 FILE *
 486 PerlIO_exportFILE(f,fl)
 487 PerlIO *f;
 488 int fl;
 489 {
 490  return f;
 491 }
 492
 493 #undef PerlIO_findFILE
 494 FILE *
 495 PerlIO_findFILE(f)
 496 PerlIO *f;
 497 {
 498  return f;
 499 }
 500
 501 #undef PerlIO_releaseFILE
 502 void
 503 PerlIO_releaseFILE(p,f)
 504 PerlIO *p;
 505 FILE *f;
 506 {
 507 }
 508
 509 void
 510 PerlIO_init()
 511 {
 512  /* Does nothing (yet) except force this file to be included
 513     in perl binary. That allows this file to force inclusion
 514     of other functions that may be required by loadable
 515     extensions e.g. for FileHandle::tmpfile
 516  */
 517 }
 518
 519 #endif /* USE_SFIO */
 520 #endif /* PERLIO_IS_STDIO */
 521
 522 #ifndef HAS_FSETPOS
 523 #undef PerlIO_setpos
 524 int
 525 PerlIO_setpos(f,pos)
 526 PerlIO *f;
 527 const Fpos_t *pos;
 528 {
 529  return PerlIO_seek(f,*pos,0);
 530 }
 531 #endif
 532
 533 #ifndef HAS_FGETPOS
 534 #undef PerlIO_getpos
 535 int
 536 PerlIO_getpos(f,pos)
 537 PerlIO *f;
 538 Fpos_t *pos;
 539 {
 540  *pos = PerlIO_tell(f);
 541  return 0;
 542 }
 543 #endif
 544
 545 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
 546
 547 int
 548 vprintf(fd, pat, args)
 549 FILE *fd;
 550 char *pat, *args;
 551 {
 552     _doprnt(pat, args, fd);
 553     return 0;           /* wrong, but perl doesn't use the return value */
 554 }
 555
 556 #endif
 557
 558 #ifndef PerlIO_vsprintf
 559 int
 560 PerlIO_vsprintf(s,n,fmt,ap)
 561 char *s;
 562 const char *fmt;
 563 int n;
 564 va_list ap;
 565 {
 566  int val = vsprintf(s, fmt, ap);
 567  if (n >= 0)
 568   {
 569    if (strlen(s) >= n)
 570     {
 571      PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
 572      my_exit(1);
 573     }
 574   }
 575  return val;
 576 }
 577 #endif
 578
 579 #ifndef PerlIO_sprintf
 580 int
 581 #ifdef I_STDARG
 582 PerlIO_sprintf(char *s, int n, const char *fmt,...)
 583 #else
 584 PerlIO_sprintf(s, n, fmt, va_alist)
 585 char *s;
 586 int n;
 587 const char *fmt;
 588 va_dcl
 589 #endif
 590 {
 591  va_list ap;
 592  int result;
 593 #ifdef I_STDARG
 594  va_start(ap,fmt);
 595 #else
 596  va_start(ap);
 597 #endif
 598  result = PerlIO_vsprintf(s, n, fmt, ap);
 599  va_end(ap);
 600  return result;
 601 }
 602 #endif
 603