return 0;
# else
dTHX;
+ #ifdef NETWARE
+ if (PerlLIO_setmode(fp, mode) != -1) {
+ #else
if (PerlLIO_setmode(fileno(fp), mode) != -1) {
+ #endif
# if defined(WIN32) && defined(__BORLANDC__)
/* The translation mode of the stream is maintained independent
* of the translation mode of the fd in the Borland RTL (heavy
{
PerlIO_debug("PerlIO_pop f=%p %s\n",f,l->tab->name);
if (l->tab->Popped)
- (*l->tab->Popped)(f);
- *f = l->next;
+ {
+ /* If popped returns non-zero do not free its layer structure
+ it has either done so itself, or it is shared and still in use
+ */
+ if ((*l->tab->Popped)(f) != 0)
+ return;
+ }
+ *f = l->next;;
PerlMemShared_free(l);
}
}
{
if (n >= 0 && n < av->cur)
{
- PerlIO_debug("Layer %ld is %s\n",n,av->array[n].funcs->name);
+ PerlIO_debug("Layer %"IVdf" is %s\n",n,av->array[n].funcs->name);
return av->array[n].funcs;
}
if (!def)
if (!PerlIO_def_layerlist)
{
const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
- PerlIO_def_layerlist = PerlIO_list_alloc();
-
- PerlIO_define_layer(aTHX_ &PerlIO_raw);
+ PerlIO_funcs *osLayer = &PerlIO_unix;
+ PerlIO_def_layerlist = PerlIO_list_alloc();
PerlIO_define_layer(aTHX_ &PerlIO_unix);
+#ifdef WIN32
+ PerlIO_define_layer(aTHX_ &PerlIO_win32);
+#if 0
+ osLayer = &PerlIO_win32;
+#endif
+#endif
+ PerlIO_define_layer(aTHX_ &PerlIO_raw);
PerlIO_define_layer(aTHX_ &PerlIO_perlio);
PerlIO_define_layer(aTHX_ &PerlIO_stdio);
PerlIO_define_layer(aTHX_ &PerlIO_crlf);
#endif
PerlIO_define_layer(aTHX_ &PerlIO_utf8);
PerlIO_define_layer(aTHX_ &PerlIO_byte);
- PerlIO_list_push(PerlIO_def_layerlist,PerlIO_find_layer(aTHX_ PerlIO_unix.name,0,0),&PL_sv_undef);
+ PerlIO_list_push(PerlIO_def_layerlist,PerlIO_find_layer(aTHX_ osLayer->name,0,0),&PL_sv_undef);
if (s)
{
PerlIO_parse_layers(aTHX_ PerlIO_def_layerlist,s);
PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
{
dTHX;
+ /* Save the position as current head considers it */
Off_t old = PerlIO_tell(f);
SSize_t done;
PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullsv);
+ PerlIOSelf(f,PerlIOBuf)->posn = old;
done = PerlIOBuf_unread(f,vbuf,count);
- PerlIOSelf(f,PerlIOBuf)->posn = old - done;
return done;
}
PerlIOUnix_oflags(const char *mode)
{
int oflags = -1;
+ if (*mode == 'I' || *mode == '#')
+ mode++;
switch(*mode)
{
case 'r':
if (*mode == 'I')
{
init = 1;
- mode++;
+ /* mode++; */
}
f = (*tab->Open)(aTHX_ tab, layers, n-1, mode,fd,imode,perm,NULL,narg,args);
if (f)
{
if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
{
+ /* Buffer is already a read buffer, we can overwrite any chars
+ which have been read back to buffer start
+ */
avail = (b->ptr - b->buf);
}
else
{
- avail = b->bufsiz;
+ /* Buffer is idle, set it up so whole buffer is available for unread */
+ avail = b->bufsiz;
b->end = b->buf + avail;
b->ptr = b->end;
PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
+ /* Buffer extends _back_ from where we are now */
b->posn -= b->bufsiz;
}
if (avail > (SSize_t) count)
- avail = count;
+ {
+ /* If we have space for more than count, just move count */
+ avail = count;
+ }
if (avail > 0)
{
b->ptr -= avail;
buf -= avail;
+ /* In simple stdio-like ungetc() case chars will be already there */
if (buf != b->ptr)
{
Copy(buf,b->ptr,avail,STDCHAR);
PerlIOBuf_tell(PerlIO *f)
{
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ /* b->posn is file position where b->buf was read, or will be written */
Off_t posn = b->posn;
if (b->buf)
- posn += (b->ptr - b->buf);
+ {
+ /* If buffer is valid adjust position by amount in buffer */
+ posn += (b->ptr - b->buf);
+ }
return posn;
}