(Re-)instate :pop as a "back door" to perl level layer stack

manipulation.

p4raw-id: //depot/perlio@17479

diff --git a/lib/PerlIO.pm b/lib/PerlIO.pm
index 1028c11..1ee5b88 100644 (file)
--- 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

diff --git a/perlio.c b/perlio.c
index 624a8a9..b0d2f8c 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -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