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