diff options
| -rw-r--r-- | lib/PerlIO.pm | 16 | ||||
| -rw-r--r-- | perlio.c | 54 |
2 files changed, 58 insertions, 12 deletions
diff --git a/lib/PerlIO.pm b/lib/PerlIO.pm index 1028c11013..1ee5b88815 100644 --- a/lib/PerlIO.pm +++ b/lib/PerlIO.pm @@ -133,6 +133,22 @@ a known base on which to build e.g. will construct a "binary" stream, but then enable UTF-8 translation. +=item pop + +A pseudo layer that removes the top-most layer. Gives perl code +a way to manipulate the layer stack. Should be considered +as experimental. Note that C<:pop> only works on real layers +and will not undo the effects of pseudo layers like C<:utf8>. +An example of a possible use might be: + + open($fh,...) + ... + binmode($fh,":encoding(...)"); # next chunk is encoded + ... + binmode($fh,":pop"); # back to un-encocded + +A more elegant (and safer) interface is needed. + =back =head2 Alternatives to raw @@ -915,6 +915,46 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def) return def; } +IV +PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +{ + if (PerlIOValid(f)) { + PerlIO_flush(f); + PerlIO_pop(aTHX_ f); + return 0; + } + return -1; +} + +PerlIO_funcs PerlIO_remove = { + sizeof(PerlIO_funcs), + "pop", + 0, + PERLIO_K_DUMMY | PERLIO_K_UTF8, + PerlIOPop_pushed, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, /* flush */ + NULL, /* fill */ + NULL, + NULL, + NULL, + NULL, + NULL, /* get_base */ + NULL, /* get_bufsiz */ + NULL, /* get_ptr */ + NULL, /* get_cnt */ + NULL, /* set_ptrcnt */ +}; + PerlIO_list_t * PerlIO_default_layers(pTHX) { @@ -937,6 +977,7 @@ PerlIO_default_layers(pTHX) PerlIO_define_layer(aTHX_ & PerlIO_mmap); #endif PerlIO_define_layer(aTHX_ & PerlIO_utf8); + PerlIO_define_layer(aTHX_ & PerlIO_remove); PerlIO_define_layer(aTHX_ & PerlIO_byte); PerlIO_list_push(aTHX_ PL_def_layerlist, PerlIO_find_layer(aTHX_ osLayer->name, 0, 0), @@ -1026,18 +1067,6 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg) } IV -PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) -{ - PerlIO_pop(aTHX_ f); - if (*f) { - PerlIO_flush(f); - PerlIO_pop(aTHX_ f); - return 0; - } - return -1; -} - -IV PerlIOBase_binmode(pTHX_ PerlIO *f) { if (PerlIOValid(f)) { @@ -1691,6 +1720,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) } } + /*--------------------------------------------------------------------------------------*/ /* * utf8 and raw dummy layers |