3 * Copyright (c) 1996-2000, Nick Ing-Simmons
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.
17 #define PERLIO_NOT_STDIO 0
18 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
19 /* #define PerlIO FILE */
22 * This file provides those parts of PerlIO abstraction
23 * which are not #defined in perlio.h.
24 * Which these are depends on various Configure #ifdef's
28 #define PERL_IN_PERLIO_C
33 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
35 if (!names || !*names || strEQ(names,":crlf") || strEQ(names,":raw"))
39 Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl",names);
45 #if !defined(PERL_IMPLICIT_SYS)
47 #ifdef PERLIO_IS_STDIO
52 /* Does nothing (yet) except force this file to be included
53 in perl binary. That allows this file to force inclusion
54 of other functions that may be required by loadable
55 extensions e.g. for FileHandle::tmpfile
66 #else /* PERLIO_IS_STDIO */
73 /* This section is just to make sure these functions
74 get pulled in from libsfio.a
87 /* Force this file to be included in perl binary. Which allows
88 * this file to force inclusion of other functions that may be
89 * required by loadable extensions e.g. for FileHandle::tmpfile
93 * sfio does its own 'autoflush' on stdout in common cases.
94 * Flush results in a lot of lseek()s to regular files and
95 * lot of small writes to pipes.
97 sfset(sfstdout,SF_SHARE,0);
101 /*======================================================================================*/
102 /* Implement all the PerlIO interface ourselves.
107 /* We _MUST_ have <unistd.h> if we are using lseek() and may have large files */
112 #include <sys/mman.h>
117 void PerlIO_debug(const char *fmt,...) __attribute__((format(__printf__,1,2)));
120 PerlIO_debug(const char *fmt,...)
127 char *s = PerlEnv_getenv("PERLIO_DEBUG");
129 dbg = PerlLIO_open3(s,O_WRONLY|O_CREAT|O_APPEND,0666);
136 SV *sv = newSVpvn("",0);
139 s = CopFILE(PL_curcop);
142 Perl_sv_catpvf(aTHX_ sv, "%s:%"IVdf" ", s, (IV)CopLINE(PL_curcop));
143 Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
146 PerlLIO_write(dbg,s,len);
152 /*--------------------------------------------------------------------------------------*/
154 /* Inner level routines */
156 /* Table of pointers to the PerlIO structs (malloc'ed) */
157 PerlIO *_perlio = NULL;
158 #define PERLIO_TABLE_SIZE 64
161 PerlIO_allocate(void)
163 /* Find a free slot in the table, allocating new table as necessary */
164 PerlIO **last = &_perlio;
169 last = (PerlIO **)(f);
170 for (i=1; i < PERLIO_TABLE_SIZE; i++)
178 Newz('I',f,PERLIO_TABLE_SIZE,PerlIO);
186 PerlIO_cleantable(PerlIO **tablep)
188 PerlIO *table = *tablep;
192 PerlIO_cleantable((PerlIO **) &(table[0]));
193 for (i=PERLIO_TABLE_SIZE-1; i > 0; i--)
212 PerlIO_cleantable(&_perlio);
216 PerlIO_pop(PerlIO *f)
221 (*l->tab->Popped)(f);
227 /*--------------------------------------------------------------------------------------*/
228 /* XS Interface for perl code */
234 char *s = GvNAME(gv);
235 STRLEN l = GvNAMELEN(gv);
236 PerlIO_debug("%.*s\n",(int) l,s);
240 XS(XS_perlio_unimport)
244 char *s = GvNAME(gv);
245 STRLEN l = GvNAMELEN(gv);
246 PerlIO_debug("%.*s\n",(int) l,s);
251 PerlIO_find_layer(const char *name, STRLEN len)
258 svp = hv_fetch(PerlIO_layer_hv,name,len,0);
259 if (svp && (sv = *svp) && SvROK(sv))
266 perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
270 IO *io = GvIOn((GV *)SvRV(sv));
271 PerlIO *ifp = IoIFP(io);
272 PerlIO *ofp = IoOFP(io);
273 AV *av = (AV *) mg->mg_obj;
274 Perl_warn(aTHX_ "set %_ %p %p %p",sv,io,ifp,ofp);
280 perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
284 IO *io = GvIOn((GV *)SvRV(sv));
285 PerlIO *ifp = IoIFP(io);
286 PerlIO *ofp = IoOFP(io);
287 AV *av = (AV *) mg->mg_obj;
288 Perl_warn(aTHX_ "get %_ %p %p %p",sv,io,ifp,ofp);
294 perlio_mg_clear(pTHX_ SV *sv, MAGIC *mg)
296 Perl_warn(aTHX_ "clear %_",sv);
301 perlio_mg_free(pTHX_ SV *sv, MAGIC *mg)
303 Perl_warn(aTHX_ "free %_",sv);
307 MGVTBL perlio_vtab = {
315 XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
318 SV *sv = SvRV(ST(1));
323 sv_magic(sv, (SV *)av, '~', NULL, 0);
325 mg = mg_find(sv,'~');
326 mg->mg_virtual = &perlio_vtab;
328 Perl_warn(aTHX_ "attrib %_",sv);
329 for (i=2; i < items; i++)
332 const char *name = SvPV(ST(i),len);
333 SV *layer = PerlIO_find_layer(name,len);
336 av_push(av,SvREFCNT_inc(layer));
349 PerlIO_define_layer(PerlIO_funcs *tab)
352 HV *stash = gv_stashpv("perlio::Layer", TRUE);
353 SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash);
354 hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0);
358 PerlIO_default_layer(I32 n)
363 PerlIO_funcs *tab = &PerlIO_stdio;
365 if (!PerlIO_layer_hv)
367 const char *s = PerlEnv_getenv("PERLIO");
368 newXS("perlio::import",XS_perlio_import,__FILE__);
369 newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
371 newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
373 PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI);
374 PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
375 PerlIO_define_layer(&PerlIO_unix);
376 PerlIO_define_layer(&PerlIO_perlio);
377 PerlIO_define_layer(&PerlIO_stdio);
378 PerlIO_define_layer(&PerlIO_crlf);
380 PerlIO_define_layer(&PerlIO_mmap);
382 av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_unix.name,0)));
387 while (*s && isSPACE((unsigned char)*s))
393 while (*e && !isSPACE((unsigned char)*e))
397 layer = PerlIO_find_layer(s,e-s);
400 PerlIO_debug("Pushing %.*s\n",(e-s),s);
401 av_push(PerlIO_layer_av,SvREFCNT_inc(layer));
404 Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s);
410 len = av_len(PerlIO_layer_av);
413 if (PerlIO_stdio.Set_ptrcnt)
415 av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_stdio.name,0)));
419 av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_perlio.name,0)));
421 len = av_len(PerlIO_layer_av);
425 svp = av_fetch(PerlIO_layer_av,n,0);
426 if (svp && (layer = *svp) && SvROK(layer) && SvIOK((layer = SvRV(layer))))
428 tab = INT2PTR(PerlIO_funcs *, SvIV(layer));
430 /* PerlIO_debug("Layer %d is %s\n",n,tab->name); */
435 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
439 const char *s = names;
449 while (*e && *e != ':' && !isSPACE(*e))
453 SV *layer = PerlIO_find_layer(s,e-s);
456 PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
459 PerlIO *new = PerlIO_push(f,tab,mode);
465 Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s);
474 #define PerlIO_default_top() PerlIO_default_layer(-1)
475 #define PerlIO_default_btm() PerlIO_default_layer(0)
483 PerlIO_fdopen(0,"Ir");
484 PerlIO_fdopen(1,"Iw");
485 PerlIO_fdopen(2,"Iw");
490 PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
493 Newc('L',l,tab->size,char,PerlIOl);
496 Zero(l,tab->size,char);
500 if ((*l->tab->Pushed)(f,mode) != 0)
509 /*--------------------------------------------------------------------------------------*/
510 /* Given the abstraction above the public API functions */
514 PerlIO_close(PerlIO *f)
516 int code = (*PerlIOBase(f)->tab->Close)(f);
526 PerlIO_fileno(PerlIO *f)
528 return (*PerlIOBase(f)->tab->Fileno)(f);
535 PerlIO_fdopen(int fd, const char *mode)
537 PerlIO_funcs *tab = PerlIO_default_top();
540 return (*tab->Fdopen)(tab,fd,mode);
545 PerlIO_open(const char *path, const char *mode)
547 PerlIO_funcs *tab = PerlIO_default_top();
550 return (*tab->Open)(tab,path,mode);
555 PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
560 if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0)
562 if ((*PerlIOBase(f)->tab->Pushed)(f,mode) == 0)
568 return PerlIO_open(path,mode);
573 PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
575 return (*PerlIOBase(f)->tab->Read)(f,vbuf,count);
580 PerlIO_unread(PerlIO *f, const void *vbuf, Size_t count)
582 return (*PerlIOBase(f)->tab->Unread)(f,vbuf,count);
587 PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
589 return (*PerlIOBase(f)->tab->Write)(f,vbuf,count);
594 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
596 return (*PerlIOBase(f)->tab->Seek)(f,offset,whence);
601 PerlIO_tell(PerlIO *f)
603 return (*PerlIOBase(f)->tab->Tell)(f);
608 PerlIO_flush(PerlIO *f)
612 return (*PerlIOBase(f)->tab->Flush)(f);
616 PerlIO **table = &_perlio;
621 table = (PerlIO **)(f++);
622 for (i=1; i < PERLIO_TABLE_SIZE; i++)
624 if (*f && PerlIO_flush(f) != 0)
635 PerlIO_fill(PerlIO *f)
637 return (*PerlIOBase(f)->tab->Fill)(f);
642 PerlIO_isutf8(PerlIO *f)
644 return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
649 PerlIO_eof(PerlIO *f)
651 return (*PerlIOBase(f)->tab->Eof)(f);
656 PerlIO_error(PerlIO *f)
658 return (*PerlIOBase(f)->tab->Error)(f);
661 #undef PerlIO_clearerr
663 PerlIO_clearerr(PerlIO *f)
665 (*PerlIOBase(f)->tab->Clearerr)(f);
668 #undef PerlIO_setlinebuf
670 PerlIO_setlinebuf(PerlIO *f)
672 (*PerlIOBase(f)->tab->Setlinebuf)(f);
675 #undef PerlIO_has_base
677 PerlIO_has_base(PerlIO *f)
681 return (PerlIOBase(f)->tab->Get_base != NULL);
686 #undef PerlIO_fast_gets
688 PerlIO_fast_gets(PerlIO *f)
692 PerlIOl *l = PerlIOBase(f);
693 return (l->tab->Set_ptrcnt != NULL);
698 #undef PerlIO_has_cntptr
700 PerlIO_has_cntptr(PerlIO *f)
704 PerlIO_funcs *tab = PerlIOBase(f)->tab;
705 return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
710 #undef PerlIO_canset_cnt
712 PerlIO_canset_cnt(PerlIO *f)
716 PerlIOl *l = PerlIOBase(f);
717 return (l->tab->Set_ptrcnt != NULL);
722 #undef PerlIO_get_base
724 PerlIO_get_base(PerlIO *f)
726 return (*PerlIOBase(f)->tab->Get_base)(f);
729 #undef PerlIO_get_bufsiz
731 PerlIO_get_bufsiz(PerlIO *f)
733 return (*PerlIOBase(f)->tab->Get_bufsiz)(f);
736 #undef PerlIO_get_ptr
738 PerlIO_get_ptr(PerlIO *f)
740 return (*PerlIOBase(f)->tab->Get_ptr)(f);
743 #undef PerlIO_get_cnt
745 PerlIO_get_cnt(PerlIO *f)
747 return (*PerlIOBase(f)->tab->Get_cnt)(f);
750 #undef PerlIO_set_cnt
752 PerlIO_set_cnt(PerlIO *f,int cnt)
754 (*PerlIOBase(f)->tab->Set_ptrcnt)(f,NULL,cnt);
757 #undef PerlIO_set_ptrcnt
759 PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
761 (*PerlIOBase(f)->tab->Set_ptrcnt)(f,ptr,cnt);
764 /*--------------------------------------------------------------------------------------*/
765 /* "Methods" of the "base class" */
768 PerlIOBase_fileno(PerlIO *f)
770 return PerlIO_fileno(PerlIONext(f));
774 PerlIOBase_pushed(PerlIO *f, const char *mode)
776 PerlIOl *l = PerlIOBase(f);
777 l->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
778 PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
784 l->flags = PERLIO_F_CANREAD;
787 l->flags = PERLIO_F_APPEND|PERLIO_F_CANWRITE;
790 l->flags = PERLIO_F_TRUNCATE|PERLIO_F_CANWRITE;
801 l->flags |= PERLIO_F_CANREAD|PERLIO_F_CANWRITE;
804 l->flags |= PERLIO_F_BINARY;
816 l->flags |= l->next->flags &
817 (PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
818 PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
825 PerlIOBase_popped(PerlIO *f)
831 PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
833 Off_t old = PerlIO_tell(f);
834 if (PerlIO_seek(f,-((Off_t)count),SEEK_CUR) == 0)
836 Off_t new = PerlIO_tell(f);
843 PerlIOBase_noop_ok(PerlIO *f)
849 PerlIOBase_noop_fail(PerlIO *f)
855 PerlIOBase_close(PerlIO *f)
858 if (PerlIO_flush(f) != 0)
860 if (PerlIO_close(PerlIONext(f)) != 0)
862 PerlIOBase(f)->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|PERLIO_F_OPEN);
867 PerlIOBase_eof(PerlIO *f)
871 return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0;
877 PerlIOBase_error(PerlIO *f)
881 return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0;
887 PerlIOBase_clearerr(PerlIO *f)
891 PerlIOBase(f)->flags &= ~PERLIO_F_ERROR;
896 PerlIOBase_setlinebuf(PerlIO *f)
901 /*--------------------------------------------------------------------------------------*/
902 /* Bottom-most level for UNIX-like case */
906 struct _PerlIO base; /* The generic part */
907 int fd; /* UNIX like file descriptor */
908 int oflags; /* open/fcntl flags */
912 PerlIOUnix_oflags(const char *mode)
927 oflags = O_CREAT|O_TRUNC;
938 oflags = O_CREAT|O_APPEND;
953 if (*mode || oflags == -1)
962 PerlIOUnix_fileno(PerlIO *f)
964 return PerlIOSelf(f,PerlIOUnix)->fd;
968 PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode)
975 int oflags = PerlIOUnix_oflags(mode);
978 PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix);
981 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
988 PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
991 int oflags = PerlIOUnix_oflags(mode);
994 int fd = PerlLIO_open3(path,oflags,0666);
997 PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix);
1000 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
1007 PerlIOUnix_reopen(const char *path, const char *mode, PerlIO *f)
1009 PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix);
1010 int oflags = PerlIOUnix_oflags(mode);
1011 if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
1012 (*PerlIOBase(f)->tab->Close)(f);
1015 int fd = PerlLIO_open3(path,oflags,0666);
1020 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
1028 PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
1030 int fd = PerlIOSelf(f,PerlIOUnix)->fd;
1031 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
1035 SSize_t len = PerlLIO_read(fd,vbuf,count);
1036 if (len >= 0 || errno != EINTR)
1039 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1040 else if (len == 0 && count != 0)
1041 PerlIOBase(f)->flags |= PERLIO_F_EOF;
1048 PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
1050 int fd = PerlIOSelf(f,PerlIOUnix)->fd;
1053 SSize_t len = PerlLIO_write(fd,vbuf,count);
1054 if (len >= 0 || errno != EINTR)
1057 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1064 PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
1066 Off_t new = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
1067 PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
1068 return (new == (Off_t) -1) ? -1 : 0;
1072 PerlIOUnix_tell(PerlIO *f)
1074 return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
1078 PerlIOUnix_close(PerlIO *f)
1080 int fd = PerlIOSelf(f,PerlIOUnix)->fd;
1082 while (PerlLIO_close(fd) != 0)
1092 PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
1097 PerlIO_funcs PerlIO_unix = {
1113 PerlIOBase_noop_ok, /* flush */
1114 PerlIOBase_noop_fail, /* fill */
1117 PerlIOBase_clearerr,
1118 PerlIOBase_setlinebuf,
1119 NULL, /* get_base */
1120 NULL, /* get_bufsiz */
1123 NULL, /* set_ptrcnt */
1126 /*--------------------------------------------------------------------------------------*/
1127 /* stdio as a layer */
1131 struct _PerlIO base;
1132 FILE * stdio; /* The stream */
1136 PerlIOStdio_fileno(PerlIO *f)
1138 return fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
1143 PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
1171 stdio = fdopen(fd,mode);
1174 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio);
1181 #undef PerlIO_importFILE
1183 PerlIO_importFILE(FILE *stdio, int fl)
1188 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"r+"),PerlIOStdio);
1195 PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
1198 FILE *stdio = fopen(path,mode);
1201 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio);
1208 PerlIOStdio_reopen(const char *path, const char *mode, PerlIO *f)
1210 PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
1211 FILE *stdio = freopen(path,mode,s->stdio);
1219 PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
1221 FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
1225 STDCHAR *buf = (STDCHAR *) vbuf;
1226 /* Perl is expecting PerlIO_getc() to fill the buffer
1227 * Linux's stdio does not do that for fread()
1237 got = fread(vbuf,1,count,s);
1242 PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
1244 FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
1245 STDCHAR *buf = ((STDCHAR *)vbuf)+count-1;
1249 int ch = *buf-- & 0xff;
1250 if (ungetc(ch,s) != ch)
1259 PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count)
1261 return fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio);
1265 PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence)
1267 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1268 return fseek(stdio,offset,whence);
1272 PerlIOStdio_tell(PerlIO *f)
1274 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1275 return ftell(stdio);
1279 PerlIOStdio_close(PerlIO *f)
1281 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1282 return fclose(stdio);
1286 PerlIOStdio_flush(PerlIO *f)
1288 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1289 if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
1291 return fflush(stdio);
1296 /* FIXME: This discards ungetc() and pre-read stuff which is
1297 not right if this is just a "sync" from a layer above
1298 Suspect right design is to do _this_ but not have layer above
1299 flush this layer read-to-read
1301 /* Not writeable - sync by attempting a seek */
1303 if (fseek(stdio,(Off_t) 0, SEEK_CUR) != 0)
1311 PerlIOStdio_fill(PerlIO *f)
1313 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1315 /* fflush()ing read-only streams can cause trouble on some stdio-s */
1316 if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
1318 if (fflush(stdio) != 0)
1322 if (c == EOF || ungetc(c,stdio) != c)
1328 PerlIOStdio_eof(PerlIO *f)
1330 return feof(PerlIOSelf(f,PerlIOStdio)->stdio);
1334 PerlIOStdio_error(PerlIO *f)
1336 return ferror(PerlIOSelf(f,PerlIOStdio)->stdio);
1340 PerlIOStdio_clearerr(PerlIO *f)
1342 clearerr(PerlIOSelf(f,PerlIOStdio)->stdio);
1346 PerlIOStdio_setlinebuf(PerlIO *f)
1348 #ifdef HAS_SETLINEBUF
1349 setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio);
1351 setvbuf(PerlIOSelf(f,PerlIOStdio)->stdio, Nullch, _IOLBF, 0);
1357 PerlIOStdio_get_base(PerlIO *f)
1359 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1360 return FILE_base(stdio);
1364 PerlIOStdio_get_bufsiz(PerlIO *f)
1366 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1367 return FILE_bufsiz(stdio);
1371 #ifdef USE_STDIO_PTR
1373 PerlIOStdio_get_ptr(PerlIO *f)
1375 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1376 return FILE_ptr(stdio);
1380 PerlIOStdio_get_cnt(PerlIO *f)
1382 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1383 return FILE_cnt(stdio);
1387 PerlIOStdio_set_ptrcnt(PerlIO *f,STDCHAR *ptr,SSize_t cnt)
1389 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1392 #ifdef STDIO_PTR_LVALUE
1393 FILE_ptr(stdio) = ptr;
1394 #ifdef STDIO_PTR_LVAL_SETS_CNT
1395 if (FILE_cnt(stdio) != (cnt))
1398 assert(FILE_cnt(stdio) == (cnt));
1401 #if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
1402 /* Setting ptr _does_ change cnt - we are done */
1405 #else /* STDIO_PTR_LVALUE */
1407 #endif /* STDIO_PTR_LVALUE */
1409 /* Now (or only) set cnt */
1410 #ifdef STDIO_CNT_LVALUE
1411 FILE_cnt(stdio) = cnt;
1412 #else /* STDIO_CNT_LVALUE */
1413 #if (defined(STDIO_PTR_LVALUE) && defined(STDIO_PTR_LVAL_SETS_CNT))
1414 FILE_ptr(stdio) = FILE_ptr(stdio)+(FILE_cnt(stdio)-cnt);
1415 #else /* STDIO_PTR_LVAL_SETS_CNT */
1417 #endif /* STDIO_PTR_LVAL_SETS_CNT */
1418 #endif /* STDIO_CNT_LVALUE */
1423 PerlIO_funcs PerlIO_stdio = {
1425 sizeof(PerlIOStdio),
1443 PerlIOStdio_clearerr,
1444 PerlIOStdio_setlinebuf,
1446 PerlIOStdio_get_base,
1447 PerlIOStdio_get_bufsiz,
1452 #ifdef USE_STDIO_PTR
1453 PerlIOStdio_get_ptr,
1454 PerlIOStdio_get_cnt,
1455 #if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
1456 PerlIOStdio_set_ptrcnt
1457 #else /* STDIO_PTR_LVALUE */
1459 #endif /* STDIO_PTR_LVALUE */
1460 #else /* USE_STDIO_PTR */
1464 #endif /* USE_STDIO_PTR */
1467 #undef PerlIO_exportFILE
1469 PerlIO_exportFILE(PerlIO *f, int fl)
1472 /* Should really push stdio discipline when we have them */
1473 return fdopen(PerlIO_fileno(f),"r+");
1476 #undef PerlIO_findFILE
1478 PerlIO_findFILE(PerlIO *f)
1480 return PerlIO_exportFILE(f,0);
1483 #undef PerlIO_releaseFILE
1485 PerlIO_releaseFILE(PerlIO *p, FILE *f)
1489 /*--------------------------------------------------------------------------------------*/
1490 /* perlio buffer layer */
1493 PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
1495 PerlIO_funcs *tab = PerlIO_default_btm();
1503 f = (*tab->Fdopen)(tab,fd,mode);
1506 /* Initial stderr is unbuffered */
1507 if (!init || fd != 2)
1509 PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf);
1510 b->posn = PerlIO_tell(PerlIONext(f));
1517 PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
1519 PerlIO_funcs *tab = PerlIO_default_btm();
1520 PerlIO *f = (*tab->Open)(tab,path,mode);
1523 PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf);
1524 b->posn = PerlIO_tell(PerlIONext(f));
1530 PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
1532 PerlIO *next = PerlIONext(f);
1533 int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
1535 code = (*PerlIOBase(f)->tab->Pushed)(f,mode);
1538 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1539 b->posn = PerlIO_tell(PerlIONext(f));
1544 /* This "flush" is akin to sfio's sync in that it handles files in either
1548 PerlIOBuf_flush(PerlIO *f)
1550 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1552 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
1554 /* write() the buffer */
1555 STDCHAR *p = b->buf;
1557 PerlIO *n = PerlIONext(f);
1560 count = PerlIO_write(n,p,b->ptr - p);
1565 else if (count < 0 || PerlIO_error(n))
1567 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1572 b->posn += (p - b->buf);
1574 else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
1576 /* Note position change */
1577 b->posn += (b->ptr - b->buf);
1578 if (b->ptr < b->end)
1580 /* We did not consume all of it */
1581 if (PerlIO_seek(PerlIONext(f),b->posn,SEEK_SET) == 0)
1583 b->posn = PerlIO_tell(PerlIONext(f));
1587 b->ptr = b->end = b->buf;
1588 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
1589 /* FIXME: Is this right for read case ? */
1590 if (PerlIO_flush(PerlIONext(f)) != 0)
1596 PerlIOBuf_fill(PerlIO *f)
1598 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1599 PerlIO *n = PerlIONext(f);
1601 /* FIXME: doing the down-stream flush is a bad idea if it causes
1602 pre-read data in stdio buffer to be discarded
1603 but this is too simplistic - as it skips _our_ hosekeeping
1604 and breaks tell tests.
1605 if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
1609 if (PerlIO_flush(f) != 0)
1612 b->ptr = b->end = b->buf;
1613 if (PerlIO_fast_gets(n))
1615 /* Layer below is also buffered
1616 * We do _NOT_ want to call its ->Read() because that will loop
1617 * till it gets what we asked for which may hang on a pipe etc.
1618 * Instead take anything it has to hand, or ask it to fill _once_.
1620 avail = PerlIO_get_cnt(n);
1623 avail = PerlIO_fill(n);
1625 avail = PerlIO_get_cnt(n);
1628 if (!PerlIO_error(n) && PerlIO_eof(n))
1634 STDCHAR *ptr = PerlIO_get_ptr(n);
1635 SSize_t cnt = avail;
1636 if (avail > b->bufsiz)
1638 Copy(ptr,b->buf,avail,STDCHAR);
1639 PerlIO_set_ptrcnt(n,ptr+avail,cnt-avail);
1644 avail = PerlIO_read(n,b->ptr,b->bufsiz);
1649 PerlIOBase(f)->flags |= PERLIO_F_EOF;
1651 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1654 b->end = b->buf+avail;
1655 PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
1660 PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count)
1662 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1663 STDCHAR *buf = (STDCHAR *) vbuf;
1669 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
1673 SSize_t avail = (b->end - b->ptr);
1674 if ((SSize_t) count < avail)
1678 Copy(b->ptr,buf,avail,STDCHAR);
1684 if (count && (b->ptr >= b->end))
1686 if (PerlIO_fill(f) != 0)
1696 PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
1698 const STDCHAR *buf = (const STDCHAR *) vbuf+count;
1699 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1702 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
1708 if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
1710 avail = (b->ptr - b->buf);
1711 if (avail > (SSize_t) count)
1718 if (avail > (SSize_t) count)
1720 b->end = b->ptr + avail;
1727 Copy(buf,b->ptr,avail,STDCHAR);
1731 PerlIOBase(f)->flags &= ~ PERLIO_F_EOF;
1738 PerlIOBuf_write(PerlIO *f, const void *vbuf, Size_t count)
1740 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1741 const STDCHAR *buf = (const STDCHAR *) vbuf;
1745 if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
1749 SSize_t avail = b->bufsiz - (b->ptr - b->buf);
1750 if ((SSize_t) count < avail)
1752 PerlIOBase(f)->flags |= PERLIO_F_WRBUF;
1753 if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF)
1773 Copy(buf,b->ptr,avail,STDCHAR);
1780 if (b->ptr >= (b->buf + b->bufsiz))
1787 PerlIOBuf_seek(PerlIO *f, Off_t offset, int whence)
1789 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1790 int code = PerlIO_flush(f);
1793 PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
1794 code = PerlIO_seek(PerlIONext(f),offset,whence);
1797 b->posn = PerlIO_tell(PerlIONext(f));
1804 PerlIOBuf_tell(PerlIO *f)
1806 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1807 Off_t posn = b->posn;
1809 posn += (b->ptr - b->buf);
1814 PerlIOBuf_close(PerlIO *f)
1816 IV code = PerlIOBase_close(f);
1817 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1818 if (b->buf && b->buf != (STDCHAR *) &b->oneword)
1823 b->ptr = b->end = b->buf;
1824 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
1829 PerlIOBuf_setlinebuf(PerlIO *f)
1833 PerlIOBase(f)->flags &= ~PERLIO_F_LINEBUF;
1838 PerlIOBuf_get_ptr(PerlIO *f)
1840 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1847 PerlIOBuf_get_cnt(PerlIO *f)
1849 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1852 if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
1853 return (b->end - b->ptr);
1858 PerlIOBuf_get_base(PerlIO *f)
1860 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1865 New('B',b->buf,b->bufsiz,STDCHAR);
1868 b->buf = (STDCHAR *)&b->oneword;
1869 b->bufsiz = sizeof(b->oneword);
1878 PerlIOBuf_bufsiz(PerlIO *f)
1880 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1883 return (b->end - b->buf);
1887 PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
1889 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1893 if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf)
1896 assert(PerlIO_get_cnt(f) == cnt);
1897 assert(b->ptr >= b->buf);
1899 PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
1902 PerlIO_funcs PerlIO_perlio = {
1922 PerlIOBase_clearerr,
1923 PerlIOBuf_setlinebuf,
1928 PerlIOBuf_set_ptrcnt,
1931 /*--------------------------------------------------------------------------------------*/
1932 /* crlf - translation currently just a copy of perlio to prove
1933 that extra buffering which real one will do is not an issue.
1936 PerlIO_funcs PerlIO_crlf = {
1956 PerlIOBase_clearerr,
1957 PerlIOBuf_setlinebuf,
1962 PerlIOBuf_set_ptrcnt,
1966 /*--------------------------------------------------------------------------------------*/
1967 /* mmap as "buffer" layer */
1971 PerlIOBuf base; /* PerlIOBuf stuff */
1972 Mmap_t mptr; /* Mapped address */
1973 Size_t len; /* mapped length */
1974 STDCHAR *bbuf; /* malloced buffer if map fails */
1978 static size_t page_size = 0;
1981 PerlIOMmap_map(PerlIO *f)
1984 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
1985 PerlIOBuf *b = &m->base;
1986 IV flags = PerlIOBase(f)->flags;
1990 if (flags & PERLIO_F_CANREAD)
1992 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1993 int fd = PerlIO_fileno(f);
1995 code = fstat(fd,&st);
1996 if (code == 0 && S_ISREG(st.st_mode))
1998 SSize_t len = st.st_size - b->posn;
2003 #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
2005 SETERRNO(0,SS$_NORMAL);
2006 # ifdef _SC_PAGESIZE
2007 page_size = sysconf(_SC_PAGESIZE);
2009 page_size = sysconf(_SC_PAGE_SIZE);
2011 if ((long)page_size < 0) {
2016 (void)SvUPGRADE(error, SVt_PV);
2017 msg = SvPVx(error, n_a);
2018 Perl_croak(aTHX_ "panic: sysconf: %s", msg);
2021 Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
2025 # ifdef HAS_GETPAGESIZE
2026 page_size = getpagesize();
2028 # if defined(I_SYS_PARAM) && defined(PAGESIZE)
2029 page_size = PAGESIZE; /* compiletime, bad */
2033 if ((IV)page_size <= 0)
2034 Perl_croak(aTHX_ "panic: bad pagesize %"IVdf, (IV)page_size);
2038 /* This is a hack - should never happen - open should have set it ! */
2039 b->posn = PerlIO_tell(PerlIONext(f));
2041 posn = (b->posn / page_size) * page_size;
2042 len = st.st_size - posn;
2043 m->mptr = mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, posn);
2044 if (m->mptr && m->mptr != (Mmap_t) -1)
2046 #if defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
2047 madvise(m->mptr, len, MADV_SEQUENTIAL);
2049 PerlIOBase(f)->flags = (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF;
2050 b->end = ((STDCHAR *)m->mptr) + len;
2051 b->buf = ((STDCHAR *)m->mptr) + (b->posn - posn);
2062 PerlIOBase(f)->flags = flags | PERLIO_F_EOF | PERLIO_F_RDBUF;
2064 b->ptr = b->end = b->ptr;
2073 PerlIOMmap_unmap(PerlIO *f)
2075 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2076 PerlIOBuf *b = &m->base;
2082 code = munmap(m->mptr, m->len);
2086 if (PerlIO_seek(PerlIONext(f),b->posn,SEEK_SET) != 0)
2089 b->ptr = b->end = b->buf;
2090 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
2096 PerlIOMmap_get_base(PerlIO *f)
2098 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2099 PerlIOBuf *b = &m->base;
2100 if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF))
2102 /* Already have a readbuffer in progress */
2107 /* We have a write buffer or flushed PerlIOBuf read buffer */
2108 m->bbuf = b->buf; /* save it in case we need it again */
2109 b->buf = NULL; /* Clear to trigger below */
2113 PerlIOMmap_map(f); /* Try and map it */
2116 /* Map did not work - recover PerlIOBuf buffer if we have one */
2120 b->ptr = b->end = b->buf;
2123 return PerlIOBuf_get_base(f);
2127 PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count)
2129 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2130 PerlIOBuf *b = &m->base;
2131 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
2133 if (b->ptr && (b->ptr - count) >= b->buf && memEQ(b->ptr - count,vbuf,count))
2136 PerlIOBase(f)->flags &= ~ PERLIO_F_EOF;
2141 /* Loose the unwritable mapped buffer */
2143 /* If flush took the "buffer" see if we have one from before */
2144 if (!b->buf && m->bbuf)
2148 PerlIOBuf_get_base(f);
2152 return PerlIOBuf_unread(f,vbuf,count);
2156 PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count)
2158 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2159 PerlIOBuf *b = &m->base;
2160 if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF))
2162 /* No, or wrong sort of, buffer */
2165 if (PerlIOMmap_unmap(f) != 0)
2168 /* If unmap took the "buffer" see if we have one from before */
2169 if (!b->buf && m->bbuf)
2173 PerlIOBuf_get_base(f);
2177 return PerlIOBuf_write(f,vbuf,count);
2181 PerlIOMmap_flush(PerlIO *f)
2183 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2184 PerlIOBuf *b = &m->base;
2185 IV code = PerlIOBuf_flush(f);
2186 /* Now we are "synced" at PerlIOBuf level */
2191 /* Unmap the buffer */
2192 if (PerlIOMmap_unmap(f) != 0)
2197 /* We seem to have a PerlIOBuf buffer which was not mapped
2198 * remember it in case we need one later
2207 PerlIOMmap_fill(PerlIO *f)
2209 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
2210 IV code = PerlIO_flush(f);
2211 if (code == 0 && !b->buf)
2213 code = PerlIOMmap_map(f);
2215 if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
2217 code = PerlIOBuf_fill(f);
2223 PerlIOMmap_close(PerlIO *f)
2225 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2226 PerlIOBuf *b = &m->base;
2227 IV code = PerlIO_flush(f);
2232 b->ptr = b->end = b->buf;
2234 if (PerlIOBuf_close(f) != 0)
2240 PerlIO_funcs PerlIO_mmap = {
2260 PerlIOBase_clearerr,
2261 PerlIOBuf_setlinebuf,
2262 PerlIOMmap_get_base,
2266 PerlIOBuf_set_ptrcnt,
2269 #endif /* HAS_MMAP */
2276 atexit(&PerlIO_cleanup);
2285 PerlIO_stdstreams();
2289 #undef PerlIO_stdout
2294 PerlIO_stdstreams();
2298 #undef PerlIO_stderr
2303 PerlIO_stdstreams();
2307 /*--------------------------------------------------------------------------------------*/
2309 #undef PerlIO_getname
2311 PerlIO_getname(PerlIO *f, char *buf)
2314 Perl_croak(aTHX_ "Don't know how to get file name");
2319 /*--------------------------------------------------------------------------------------*/
2320 /* Functions which can be called on any kind of PerlIO implemented
2326 PerlIO_getc(PerlIO *f)
2329 SSize_t count = PerlIO_read(f,buf,1);
2332 return (unsigned char) buf[0];
2337 #undef PerlIO_ungetc
2339 PerlIO_ungetc(PerlIO *f, int ch)
2344 if (PerlIO_unread(f,&buf,1) == 1)
2352 PerlIO_putc(PerlIO *f, int ch)
2355 return PerlIO_write(f,&buf,1);
2360 PerlIO_puts(PerlIO *f, const char *s)
2362 STRLEN len = strlen(s);
2363 return PerlIO_write(f,s,len);
2366 #undef PerlIO_rewind
2368 PerlIO_rewind(PerlIO *f)
2370 PerlIO_seek(f,(Off_t)0,SEEK_SET);
2374 #undef PerlIO_vprintf
2376 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
2379 SV *sv = newSVpvn("",0);
2384 Perl_va_copy(ap, apc);
2385 sv_vcatpvf(sv, fmt, &apc);
2387 sv_vcatpvf(sv, fmt, &ap);
2390 return PerlIO_write(f,s,len);
2393 #undef PerlIO_printf
2395 PerlIO_printf(PerlIO *f,const char *fmt,...)
2400 result = PerlIO_vprintf(f,fmt,ap);
2405 #undef PerlIO_stdoutf
2407 PerlIO_stdoutf(const char *fmt,...)
2412 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
2417 #undef PerlIO_tmpfile
2419 PerlIO_tmpfile(void)
2421 /* I have no idea how portable mkstemp() is ... */
2422 #if defined(WIN32) || !defined(HAVE_MKSTEMP)
2424 FILE *stdio = tmpfile();
2427 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"w+"),PerlIOStdio);
2433 SV *sv = newSVpv("/tmp/PerlIO_XXXXXX",0);
2434 int fd = mkstemp(SvPVX(sv));
2438 f = PerlIO_fdopen(fd,"w+");
2441 PerlIOBase(f)->flags |= PERLIO_F_TEMP;
2443 PerlLIO_unlink(SvPVX(sv));
2453 #endif /* USE_SFIO */
2454 #endif /* PERLIO_IS_STDIO */
2456 /*======================================================================================*/
2457 /* Now some functions in terms of above which may be needed even if
2458 we are not in true PerlIO mode
2462 #undef PerlIO_setpos
2464 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
2466 return PerlIO_seek(f,*pos,0);
2469 #ifndef PERLIO_IS_STDIO
2470 #undef PerlIO_setpos
2472 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
2474 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
2475 return fsetpos64(f, pos);
2477 return fsetpos(f, pos);
2484 #undef PerlIO_getpos
2486 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
2488 *pos = PerlIO_tell(f);
2489 return *pos == -1 ? -1 : 0;
2492 #ifndef PERLIO_IS_STDIO
2493 #undef PerlIO_getpos
2495 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
2497 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
2498 return fgetpos64(f, pos);
2500 return fgetpos(f, pos);
2506 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
2509 vprintf(char *pat, char *args)
2511 _doprnt(pat, args, stdout);
2512 return 0; /* wrong, but perl doesn't use the return value */
2516 vfprintf(FILE *fd, char *pat, char *args)
2518 _doprnt(pat, args, fd);
2519 return 0; /* wrong, but perl doesn't use the return value */
2524 #ifndef PerlIO_vsprintf
2526 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
2528 int val = vsprintf(s, fmt, ap);
2531 if (strlen(s) >= (STRLEN)n)
2534 (void)PerlIO_puts(Perl_error_log,
2535 "panic: sprintf overflow - memory corrupted!\n");
2543 #ifndef PerlIO_sprintf
2545 PerlIO_sprintf(char *s, int n, const char *fmt,...)
2550 result = PerlIO_vsprintf(s, n, fmt, ap);
2556 #endif /* !PERL_IMPLICIT_SYS */