int
PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
{
- if (!names || !*names || strEQ(names, ":crlf") || strEQ(names, ":raw")) {
+ if (!names || !*names
+ || strEQ(names, ":crlf")
+ || strEQ(names, ":raw")
+ || strEQ(names, ":bytes")
+ ) {
return 0;
}
Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl", names);
return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
}
else {
+ if (*f) {
+ /* Turn off UTF-8-ness, to undo UTF-8 locale effects
+ This may be too simplistic!
+ */
+ PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
+ }
/* FIXME?: Looking down the layer stack seems wrong,
but is a way of reaching past (say) an encoding layer
to flip CRLF-ness of the layer(s) below
PerlIO_funcs PerlIO_utf8 = {
"utf8",
sizeof(PerlIOl),
- PERLIO_K_DUMMY | PERLIO_F_UTF8,
+ PERLIO_K_DUMMY | PERLIO_K_UTF8,
PerlIOUtf8_pushed,
NULL,
NULL,
* stdio as a layer
*/
+#if defined(VMS) && !defined(STDIO_BUFFER_WRITABLE)
+/* perl5.8 - This ensures the last minute VMS ungetc fix is not
+ broken by the last second glibc 2.3 fix
+ */
+#define STDIO_BUFFER_WRITABLE
+#endif
+
+
typedef struct {
struct _PerlIO base;
FILE *stdio; /* The stream */
SSize_t unread = 0;
FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
- if (PerlIO_fast_gets(f)) {
+#ifdef STDIO_BUFFER_WRITABLE
+ if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) {
STDCHAR *buf = ((STDCHAR *) vbuf) + count;
STDCHAR *base = PerlIO_get_base(f);
SSize_t cnt = PerlIO_get_cnt(f);
count -= avail;
unread += avail;
PerlIO_set_ptrcnt(f,ptr,cnt+avail);
+ if (PerlSIO_feof(s) && unread >= 0)
+ PerlSIO_clearerr(s);
+ }
+ }
+ else
+#endif
+ if (PerlIO_has_cntptr(f)) {
+ /* We can get pointer to buffer but not its base
+ Do ungetc() but check chars are ending up in the
+ buffer
+ */
+ STDCHAR *eptr = (STDCHAR*)PerlSIO_get_ptr(s);
+ STDCHAR *buf = ((STDCHAR *) vbuf) + count;
+ while (count > 0) {
+ int ch = *--buf & 0xFF;
+ if (ungetc(ch,s) != ch) {
+ /* ungetc did not work */
+ break;
+ }
+ if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) {
+ /* Did not change pointer as expected */
+ fgetc(s); /* get char back again */
+ break;
+ }
+ /* It worked ! */
+ count--;
+ unread++;
}
}
if (count > 0) {
unread += PerlIOBase_unread(aTHX_ f, vbuf, count);
}
- if (PerlSIO_feof(s) && unread >= 0)
- PerlSIO_clearerr(s);
return unread;
}
return EOF;
#if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
- if (PerlIO_fast_gets(f)) {
+
+#ifdef STDIO_BUFFER_WRITABLE
+ if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) {
/* Fake ungetc() to the real buffer in case system's ungetc
goes elsewhere
*/
return 0;
}
}
+ else
+#endif
+ if (PerlIO_has_cntptr(f)) {
+ STDCHAR ch = c;
+ if (PerlIOStdio_unread(aTHX_ f,&ch,1) == 1) {
+ return 0;
+ }
+ }
#endif
#if defined(VMS)
(*stdio)->_cnt++;
#else
/* If buffer snoop scheme above fails fall back to
- using ungetc (but why did "fill" get called?).
+ using ungetc().
*/
if (PerlSIO_ungetc(c, stdio) != c)
return EOF;
/* Reload n as some layers may pop themselves on seek */
b->posn = PerlIO_tell(n = PerlIONext(f));
}
+ else {
+ return code;
+ }
}
}
b->ptr = b->end = b->buf;