/*
- * perlio.c Copyright (c) 1996-2005, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2006, Nick Ing-Simmons You may distribute
* under the terms of either the GNU General Public License or the
* Artistic License, as specified in the README file.
*/
const int fd = PerlLIO_dup(PerlIO_fileno(f));
if (fd >= 0) {
char mode[8];
- int omode = fcntl(fd, F_GETFL);
#ifdef DJGPP
- omode = djgpp_get_stream_mode(f);
+ const int omode = djgpp_get_stream_mode(f);
+#else
+ const int omode = fcntl(fd, F_GETFL);
#endif
PerlIO_intmode2str(omode,mode,NULL);
/* the r+ is a hack */
if (items < 2)
Perl_croak(aTHX_ "Usage class->find(name[,load])");
else {
- const char *name = SvPV_nolen_const(ST(1));
+ const char * const name = SvPV_nolen_const(ST(1));
ST(0) = (strEQ(name, "crlf")
|| strEQ(name, "raw")) ? &PL_sv_yes : &PL_sv_undef;
XSRETURN(1);
dSYS;
va_start(ap, fmt);
if (!PL_perlio_debug_fd && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
- const char *s = PerlEnv_getenv("PERLIO_DEBUG");
+ const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
if (s && *s)
PL_perlio_debug_fd = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
else
}
if (PL_perlio_debug_fd > 0) {
dTHX;
- const char *s = CopFILE(PL_curcop);
- STRLEN len;
#ifdef USE_ITHREADS
+ const char * const s = CopFILE(PL_curcop);
/* Use fixed buffer as sv_catpvf etc. needs SVs */
char buffer[1024];
- if (!s)
- s = "(none)";
- len = sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
- vsprintf(buffer+len, fmt, ap);
- PerlLIO_write(PL_perlio_debug_fd, buffer, strlen(buffer));
+ const STRLEN len = my_sprintf(buffer, "%.40s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop));
+ const STRLEN len2 = vsprintf(buffer+len, fmt, ap);
+ PerlLIO_write(PL_perlio_debug_fd, buffer, len + len2);
#else
- SV *sv = newSVpvn("", 0);
- if (!s)
- s = "(none)";
- Perl_sv_catpvf(aTHX_ sv, "%s:%" IVdf " ", s,
+ const char *s = CopFILE(PL_curcop);
+ STRLEN len;
+ SV * const sv = newSVpvs("");
+ Perl_sv_catpvf(aTHX_ sv, "%s:%" IVdf " ", s ? s : "(none)",
(IV) CopLINE(PL_curcop));
Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
PerlIO *
PerlIO_allocate(pTHX)
{
+ dVAR;
/*
* Find a free slot in the table, allocating new table as necessary
*/
void
PerlIO_cleantable(pTHX_ PerlIO **tablep)
{
- PerlIO *table = *tablep;
+ PerlIO * const table = *tablep;
if (table) {
int i;
PerlIO_cleantable(aTHX_(PerlIO **) & (table[0]));
for (i = PERLIO_TABLE_SIZE - 1; i > 0; i--) {
- PerlIO *f = table + i;
+ PerlIO * const f = table + i;
if (*f) {
PerlIO_close(f);
}
void
PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
{
+ dVAR;
PerlIO_pair_t *p;
if (list->cur >= list->len) {
list->len += 8;
void
PerlIO_destruct(pTHX)
{
+ dVAR;
PerlIO **table = &PL_perlio;
PerlIO *f;
#ifdef USE_ITHREADS
table = (PerlIO **) (f++);
for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
PerlIO *x = f;
- PerlIOl *l;
+ const PerlIOl *l;
while ((l = *x)) {
if (l->tab->kind & PERLIO_K_DESTRUCT) {
PerlIO_debug("Destruct popping %s\n", l->tab->name);
void
PerlIO_pop(pTHX_ PerlIO *f)
{
- PerlIOl *l = *f;
+ const PerlIOl *l = *f;
if (l) {
PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, l->tab->name);
if (l->tab->Popped) {
AV *
PerlIO_get_layers(pTHX_ PerlIO *f)
{
- AV *av = newAV();
+ dVAR;
+ AV * const av = newAV();
- if (PerlIOValid(f)) {
- PerlIOl *l = PerlIOBase(f);
-
- while (l) {
- SV *name = l->tab && l->tab->name ?
- newSVpv(l->tab->name, 0) : &PL_sv_undef;
- SV *arg = l->tab && l->tab->Getarg ?
- (*l->tab->Getarg)(aTHX_ &l, 0, 0) : &PL_sv_undef;
- av_push(av, name);
- av_push(av, arg);
- av_push(av, newSViv((IV)l->flags));
- l = l->next;
- }
- }
+ if (PerlIOValid(f)) {
+ PerlIOl *l = PerlIOBase(f);
+
+ while (l) {
+ SV * const name = l->tab && l->tab->name ?
+ newSVpv(l->tab->name, 0) : &PL_sv_undef;
+ SV * const arg = l->tab && l->tab->Getarg ?
+ (*l->tab->Getarg)(aTHX_ &l, 0, 0) : &PL_sv_undef;
+ av_push(av, name);
+ av_push(av, arg);
+ av_push(av, newSViv((IV)l->flags));
+ l = l->next;
+ }
+ }
- return av;
+ return av;
}
/*--------------------------------------------------------------------------------------*/
Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer");
return NULL;
} else {
- SV * const pkgsv = newSVpvn("PerlIO", 6);
+ SV * const pkgsv = newSVpvs("PerlIO");
SV * const layer = newSVpvn(name, len);
CV * const cv = get_cv("PerlIO::Layer::NoWarnings", FALSE);
ENTER;
perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
{
if (SvROK(sv)) {
- IO *io = GvIOn((GV *) SvRV(sv));
- PerlIO *ifp = IoIFP(io);
- PerlIO *ofp = IoOFP(io);
+ IO * const io = GvIOn((GV *) SvRV(sv));
+ PerlIO * const ifp = IoIFP(io);
+ PerlIO * const ofp = IoOFP(io);
Perl_warn(aTHX_ "set %" SVf " %p %p %p", sv, io, ifp, ofp);
}
return 0;
perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
if (SvROK(sv)) {
- IO *io = GvIOn((GV *) SvRV(sv));
- PerlIO *ifp = IoIFP(io);
- PerlIO *ofp = IoOFP(io);
+ IO * const io = GvIOn((GV *) SvRV(sv));
+ PerlIO * const ifp = IoIFP(io);
+ PerlIO * const ofp = IoOFP(io);
Perl_warn(aTHX_ "get %" SVf " %p %p %p", sv, io, ifp, ofp);
}
return 0;
XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
{
dXSARGS;
- SV *sv = SvRV(ST(1));
- AV *av = newAV();
+ SV * const sv = SvRV(ST(1));
+ AV * const av = newAV();
MAGIC *mg;
int count = 0;
int i;
Perl_warn(aTHX_ "attrib %" SVf, sv);
for (i = 2; i < items; i++) {
STRLEN len;
- const char *name = SvPV_const(ST(i), len);
- SV *layer = PerlIO_find_layer(aTHX_ name, len, 1);
+ const char * const name = SvPV_const(ST(i), len);
+ SV * const layer = PerlIO_find_layer(aTHX_ name, len, 1);
if (layer) {
av_push(av, SvREFCNT_inc(layer));
}
SV *
PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
{
- HV * const stash = gv_stashpv("PerlIO::Layer", TRUE);
+ HV * const stash = gv_stashpvs("PerlIO::Layer", TRUE);
SV * const sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash);
return sv;
}
/* This is used as a %SIG{__WARN__} handler to supress warnings
during loading of layers.
*/
+ dVAR;
dXSARGS;
if (items)
PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
XS(XS_PerlIO__Layer__find)
{
+ dVAR;
dXSARGS;
if (items < 2)
Perl_croak(aTHX_ "Usage class->find(name[,load])");
void
PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
{
+ dVAR;
if (!PL_known_layers)
PL_known_layers = PerlIO_list_alloc(aTHX);
PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
int
PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
{
+ dVAR;
if (names) {
const char *s = names;
while (*s) {
void
PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
{
+ dVAR;
PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio;
#ifdef PERLIO_USING_CRLF
tab = &PerlIO_crlf;
PerlIO_list_t *
PerlIO_default_layers(pTHX)
{
+ dVAR;
if (!PL_def_layerlist) {
- const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
+ const char * const s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
PL_def_layerlist = PerlIO_list_alloc(aTHX);
PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix));
PerlIO_funcs *
PerlIO_default_layer(pTHX_ I32 n)
{
+ dVAR;
PerlIO_list_t * const av = PerlIO_default_layers(aTHX);
if (n < 0)
n += av->cur;
void
PerlIO_stdstreams(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_allocate(aTHX);
PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
int
PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
{
- PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
- (void*)f, PerlIOBase(f)->tab->name, iotype, mode,
- (names) ? names : "(Null)");
+ PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f,
+ (PerlIOBase(f)) ? PerlIOBase(f)->tab->name : "(Null)",
+ iotype, mode, (names) ? names : "(Null)");
+
if (names) {
/* Do not flush etc. if (e.g.) switching encodings.
if a pushed layer knows it needs to flush lower layers
int
Perl_PerlIO_fileno(pTHX_ PerlIO *f)
{
+ dVAR;
Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
}
static const char *
PerlIO_context_layers(pTHX_ const char *mode)
{
+ dVAR;
const char *type = NULL;
/*
* Need to supply default layer info from open.pm
*/
if (PL_curcop) {
- SV *layers = PL_curcop->cop_io;
+ SV * const layers = PL_curcop->cop_io;
if (layers) {
STRLEN len;
type = SvPV_const(layers, len);
/*
* Skip to write part
*/
- const char *s = strchr(type, 0);
+ const char * const s = strchr(type, 0);
if (s && (STRLEN)(s - type) < len) {
type = s + 1;
}
static PerlIO_funcs *
PerlIO_layer_from_ref(pTHX_ SV *sv)
{
+ dVAR;
/*
* For any scalar type load the handler which is bundled with perl
*/
if (SvTYPE(sv) < SVt_PVAV)
- return PerlIO_find_layer(aTHX_ "scalar", 6, 1);
+ return PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1);
/*
* For other types allow if layer is known but don't try and load it
*/
switch (SvTYPE(sv)) {
case SVt_PVAV:
- return PerlIO_find_layer(aTHX_ "Array", 5, 0);
+ return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Array"), 0);
case SVt_PVHV:
- return PerlIO_find_layer(aTHX_ "Hash", 4, 0);
+ return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Hash"), 0);
case SVt_PVCV:
- return PerlIO_find_layer(aTHX_ "Code", 4, 0);
+ return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0);
case SVt_PVGV:
- return PerlIO_find_layer(aTHX_ "Glob", 4, 0);
+ return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0);
}
return NULL;
}
PerlIO_resolve_layers(pTHX_ const char *layers,
const char *mode, int narg, SV **args)
{
+ dVAR;
PerlIO_list_t *def = PerlIO_default_layers(aTHX);
int incdef = 1;
if (!PL_perlio)
PerlIO_stdstreams(aTHX);
if (narg) {
- SV *arg = *args;
+ SV * const arg = *args;
/*
* If it is a reference but not an object see if we have a handler
* for it
*/
}
}
- if (!layers)
+ if (!layers || !*layers)
layers = PerlIO_context_layers(aTHX_ mode);
if (layers && *layers) {
PerlIO_list_t *av;
PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
int imode, int perm, PerlIO *f, int narg, SV **args)
{
+ dVAR;
if (!f && narg == 1 && *args == &PL_sv_undef) {
if ((f = PerlIO_tmpfile())) {
- if (!layers)
+ if (!layers || !*layers)
layers = PerlIO_context_layers(aTHX_ mode);
if (layers && *layers)
PerlIO_apply_layers(aTHX_ f, mode, layers);
Perl_croak(aTHX_ "More than one argument to open(,':%s')",tab->name);
}
PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
- tab->name, layers, mode, fd, imode, perm,
- (void*)f, narg, (void*)args);
+ tab->name, layers ? layers : "(Null)", mode, fd,
+ imode, perm, (void*)f, narg, (void*)args);
if (tab->Open)
f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
f, narg, args);
int
Perl_PerlIO_flush(pTHX_ PerlIO *f)
{
+ dVAR;
if (f) {
if (*f) {
const PerlIO_funcs *tab = PerlIOBase(f)->tab;
void
PerlIOBase_flush_linebuf(pTHX)
{
+ dVAR;
PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
PerlIOBase_clearerr(pTHX_ PerlIO *f)
{
if (PerlIOValid(f)) {
- PerlIO *n = PerlIONext(f);
+ PerlIO * const n = PerlIONext(f);
PerlIOBase(f)->flags &= ~(PERLIO_F_ERROR | PERLIO_F_EOF);
if (PerlIOValid(n))
PerlIO_clearerr(n);
f = PerlIOBase_dup(aTHX_ f, nexto, param, flags);
}
if (f) {
- PerlIO_funcs *self = PerlIOBase(o)->tab;
+ PerlIO_funcs * const self = PerlIOBase(o)->tab;
SV *arg;
char buf[8];
PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
{
dTHX;
if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+ dVAR;
#ifdef USE_THREADS
MUTEX_LOCK(&PerlIO_mutex);
#endif
dTHX;
int cnt = 0;
if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+ dVAR;
#ifdef USE_THREADS
MUTEX_LOCK(&PerlIO_mutex);
#endif
void
PerlIO_cleanup(pTHX)
{
+ dVAR;
int i;
#ifdef USE_ITHREADS
PerlIO_debug("Cleanup layers for %p\n",aTHX);
}
new_loc = PerlLIO_lseek(fd, offset, whence);
if (new_loc == (Off_t) - 1)
- {
- return -1;
- }
+ return -1;
PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
return 0;
}
PerlIO *
PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
{
- PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix);
+ const PerlIOUnix * const os = PerlIOSelf(o, PerlIOUnix);
int fd = os->fd;
if (flags & PERLIO_DUP_FD) {
fd = PerlLIO_dup(fd);
SSize_t
PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
+ dVAR;
const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
#ifdef PERLIO_STD_SPECIAL
if (fd == 0)
SSize_t
PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
+ dVAR;
const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
#ifdef PERLIO_STD_SPECIAL
if (fd == 1 || fd == 2)
IV
PerlIOUnix_close(pTHX_ PerlIO *f)
{
+ dVAR;
const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
int code = 0;
if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
IV
PerlIOStdio_fileno(pTHX_ PerlIO *f)
{
- FILE *s;
- if (PerlIOValid(f) && (s = PerlIOSelf(f, PerlIOStdio)->stdio)) {
- return PerlSIO_fileno(s);
+ if (PerlIOValid(f)) {
+ FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
+ if (s)
+ return PerlSIO_fileno(s);
}
errno = EBADF;
return -1;
{
char tmode[8];
if (PerlIOValid(f)) {
- const char *path = SvPV_nolen_const(*args);
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+ const char * const path = SvPV_nolen_const(*args);
+ PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
FILE *stdio;
PerlIOUnix_refcnt_dec(fileno(s->stdio));
stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
}
else {
if (narg > 0) {
- const char *path = SvPV_nolen_const(*args);
+ const char * const path = SvPV_nolen_const(*args);
if (*mode == IoTYPE_NUMERIC) {
mode++;
fd = PerlLIO_open3(path, imode, perm);
f = PerlIO_allocate(aTHX);
}
if ((f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+ PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
s->stdio = stdio;
PerlIOUnix_refcnt_inc(fileno(s->stdio));
}
IV
PerlIOStdio_close(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (!stdio) {
errno = EBADF;
return -1;
SSize_t
PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
- FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
+ dVAR;
+ FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
SSize_t got = 0;
for (;;) {
if (count == 1) {
PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
SSize_t unread = 0;
- FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
#ifdef STDIO_BUFFER_WRITABLE
if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) {
SSize_t
PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
+ dVAR;
SSize_t got;
for (;;) {
got = PerlSIO_fwrite(vbuf, 1, count,
IV
PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_fseek(stdio, offset, whence);
}
Off_t
PerlIOStdio_tell(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_ftell(stdio);
}
IV
PerlIOStdio_flush(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
return PerlSIO_fflush(stdio);
}
/*
* Not writeable - sync by attempting a seek
*/
- int err = errno;
+ const int err = errno;
if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
errno = err;
#endif
STDCHAR *
PerlIOStdio_get_base(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return (STDCHAR*)PerlSIO_get_base(stdio);
}
Size_t
PerlIOStdio_get_bufsiz(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_get_bufsiz(stdio);
}
#endif
STDCHAR *
PerlIOStdio_get_ptr(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return (STDCHAR*)PerlSIO_get_ptr(stdio);
}
SSize_t
PerlIOStdio_get_cnt(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_get_cnt(stdio);
}
void
PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (ptr != NULL) {
#ifdef STDIO_PTR_LVALUE
PerlSIO_set_ptr(stdio, (void*)ptr); /* LHS STDCHAR* cast non-portable */
IV
PerlIOStdio_fill(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
int c;
/*
* fflush()ing read-only streams can cause trouble on some stdio-s
IV
PerlIOBuf_flush(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
int code = 0;
PerlIO *n = PerlIONext(f);
if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
IV
PerlIOBuf_fill(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
PerlIO *n = PerlIONext(f);
SSize_t avail;
/*
}
if (avail > 0) {
STDCHAR *ptr = PerlIO_get_ptr(n);
- SSize_t cnt = avail;
+ const SSize_t cnt = avail;
if (avail > (SSize_t)b->bufsiz)
avail = b->bufsiz;
Copy(ptr, b->buf, avail, STDCHAR);
PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
if (PerlIOValid(f)) {
- const PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->ptr)
PerlIO_get_base(f);
return PerlIOBase_read(aTHX_ f, vbuf, count);
PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
const STDCHAR *buf = (const STDCHAR *) vbuf + count;
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
SSize_t unread = 0;
SSize_t avail;
if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
Off_t
PerlIOBuf_tell(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
/*
* b->posn is file position where b->buf was read, or will be written
*/
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
Safefree(b->buf);
}
- b->buf = NULL;
- b->ptr = b->end = b->buf;
+ b->ptr = b->end = b->buf = NULL;
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
return code;
}
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
Safefree(b->buf);
}
- b->buf = NULL;
- b->ptr = b->end = b->buf;
+ b->ptr = b->end = b->buf = NULL;
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
return code;
}
STDCHAR *
PerlIOBuf_get_ptr(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->buf)
PerlIO_get_base(f);
return b->ptr;
SSize_t
PerlIOBuf_get_cnt(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->buf)
PerlIO_get_base(f);
if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
STDCHAR *
PerlIOBuf_get_base(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->buf) {
if (!b->bufsiz)
b->bufsiz = 4096;
b->buf = (STDCHAR *) & b->oneword;
b->bufsiz = sizeof(b->oneword);
}
- b->ptr = b->buf;
- b->end = b->ptr;
+ b->end = b->ptr = b->buf;
}
return b->buf;
}
Size_t
PerlIOBuf_bufsiz(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->buf)
PerlIO_get_base(f);
return (b->end - b->buf);
void
PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->buf)
PerlIO_get_base(f);
b->ptr = ptr;
IV
PerlIOPending_flush(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
Safefree(b->buf);
b->buf = NULL;
PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
{
const IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
- PerlIOl *l = PerlIOBase(f);
+ PerlIOl * const l = PerlIOBase(f);
/*
* Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
* etc. get muddled when it changes mid-string when we auto-pop.
SSize_t
PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
- PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
+ PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
if (c->nl) { /* XXXX Shouldn't it be done only if b->ptr > c->nl? */
*(c->nl) = 0xd;
c->nl = NULL;
b->posn -= b->bufsiz;
}
while (count > 0 && b->ptr > b->buf) {
- int ch = *--buf;
+ const int ch = *--buf;
if (ch == '\n') {
if (b->ptr - 2 >= b->buf) {
*--(b->ptr) = 0xa;
SSize_t
PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
if (!b->buf)
PerlIO_get_base(f);
if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
- PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
+ PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == 0xd)) {
STDCHAR *nl = (c->nl) ? c->nl : b->ptr;
scan:
void
PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
- PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
if (!b->buf)
PerlIO_get_base(f);
if (!ptr) {
if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF))
return PerlIOBuf_write(aTHX_ f, vbuf, count);
else {
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
const STDCHAR *buf = (const STDCHAR *) vbuf;
- const STDCHAR *ebuf = buf + count;
+ const STDCHAR * const ebuf = buf + count;
if (!b->buf)
PerlIO_get_base(f);
if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
return 0;
while (buf < ebuf) {
- STDCHAR *eptr = b->buf + b->bufsiz;
+ const STDCHAR * const eptr = b->buf + b->bufsiz;
PerlIOBase(f)->flags |= PERLIO_F_WRBUF;
while (buf < ebuf && b->ptr < eptr) {
if (*buf == '\n') {
}
}
else {
- int ch = *buf++;
- *(b->ptr)++ = ch;
+ *(b->ptr)++ = *buf++;
}
if (b->ptr >= eptr) {
PerlIO_flush(f);
IV
PerlIOCrlf_flush(pTHX_ PerlIO *f)
{
- PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
+ PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
if (c->nl) {
*(c->nl) = 0xd;
c->nl = NULL;
if (m->len)
abort();
if (flags & PERLIO_F_CANREAD) {
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
const int fd = PerlIO_fileno(f);
Stat_t st;
code = Fstat(fd, &st);
IV
PerlIOMmap_unmap(pTHX_ PerlIO *f)
{
- PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
- PerlIOBuf *b = &m->base;
+ PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
IV code = 0;
if (m->len) {
+ PerlIOBuf * const b = &m->base;
if (b->buf) {
code = munmap(m->mptr, m->len);
b->buf = NULL;
STDCHAR *
PerlIOMmap_get_base(pTHX_ PerlIO *f)
{
- PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
- PerlIOBuf *b = &m->base;
+ PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
+ PerlIOBuf * const b = &m->base;
if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
/*
* Already have a readbuffer in progress
SSize_t
PerlIOMmap_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
- PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
- PerlIOBuf *b = &m->base;
+ PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
+ PerlIOBuf * const b = &m->base;
if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
PerlIO_flush(f);
if (b->ptr && (b->ptr - count) >= b->buf
IV
PerlIOMmap_flush(pTHX_ PerlIO *f)
{
- PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
- PerlIOBuf *b = &m->base;
+ PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
+ PerlIOBuf * const b = &m->base;
IV code = PerlIOBuf_flush(aTHX_ f);
/*
* Now we are "synced" at PerlIOBuf level
IV
PerlIOMmap_fill(pTHX_ PerlIO *f)
{
- PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+ PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
IV code = PerlIO_flush(f);
if (code == 0 && !b->buf) {
code = PerlIOMmap_map(aTHX_ f);
IV
PerlIOMmap_close(pTHX_ PerlIO *f)
{
- PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
- PerlIOBuf *b = &m->base;
+ PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
+ PerlIOBuf * const b = &m->base;
IV code = PerlIO_flush(f);
if (m->bbuf) {
b->buf = m->bbuf;
PerlIO *
Perl_PerlIO_stdin(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
PerlIO *
Perl_PerlIO_stdout(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
PerlIO *
Perl_PerlIO_stderr(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
PerlIO_open(const char *path, const char *mode)
{
dTHX;
- SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
+ SV *name = sv_2mortal(newSVpv(path, 0));
return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name);
}
PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
{
dTHX;
- SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
+ SV *name = sv_2mortal(newSVpv(path,0));
return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name);
}
PerlIO_puts(PerlIO *f, const char *s)
{
dTHX;
- STRLEN len = strlen(s);
- return PerlIO_write(f, s, len);
+ return PerlIO_write(f, s, strlen(s));
}
#undef PerlIO_rewind
PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
{
dTHX;
- SV *sv = newSVpvn("", 0);
+ SV * const sv = newSVpvs("");
const char *s;
STRLEN len;
SSize_t wrote;
f = PerlIO_fdopen(fd, "w+b");
#else /* WIN32 */
# if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
- SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+ SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX");
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
SvREFCNT_dec(sv);
}
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
- FILE *stdio = PerlSIO_tmpfile();
+ FILE * const stdio = PerlSIO_tmpfile();
if (stdio) {
if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
PERLIO_FUNCS_CAST(&PerlIO_stdio),
"w+", Nullsv))) {
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+ PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
if (s)
s->stdio = stdio;
dTHX;
if (SvOK(pos)) {
STRLEN len;
- Off_t *posn = (Off_t *) SvPV(pos, len);
+ const Off_t * const posn = (Off_t *) SvPV(pos, len);
if (f && len == sizeof(Off_t))
return PerlIO_seek(f, *posn, SEEK_SET);
}
dTHX;
if (SvOK(pos)) {
STRLEN len;
- Fpos_t *fpos = (Fpos_t *) SvPV(pos, len);
+ Fpos_t * const fpos = (Fpos_t *) SvPV(pos, len);
if (f && len == sizeof(Fpos_t)) {
#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
return fsetpos64(f, fpos);
projects / p5sagit/p5-mst-13.2.git / blobdiff