Define PerlIOBase_open

diff --git a/perlio.c b/perlio.c
index 0eee430..85cb106 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1315,6 +1315,24 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
     return f;
 }
 
+PerlIO *
+PerlIOBase_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
+              IV n, const char *mode, int fd, int imode, int perm,
+              PerlIO *old, int narg, SV **args)
+{
+    PerlIO_funcs * const tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_layer(aTHX_ 0));
+    if (tab && tab->Open) {
+       PerlIO* ret = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, old, narg, args);
+       if (ret && PerlIO_push(aTHX_ ret, self, mode, PerlIOArg) == -1) {
+           PerlIO_close(ret);
+           return NULL;
+       }
+       return ret;
+    }
+    SETERRNO(EINVAL, LIB_INVARG);
+    return NULL;
+}
+
 IV
 PerlIOBase_binmode(pTHX_ PerlIO *f)
 {

diff --git a/perliol.h b/perliol.h
index 019fa8c..965910b 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -189,6 +189,7 @@ PERL_EXPORT_C IV        PerlIOBase_noop_fail(pTHX_ PerlIO *f);
 PERL_EXPORT_C IV        PerlIOBase_noop_ok(pTHX_ PerlIO *f);
 PERL_EXPORT_C IV        PerlIOBase_popped(pTHX_ PerlIO *f);
 PERL_EXPORT_C IV        PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+PERL_EXPORT_C PerlIO *  PerlIOBase_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args);
 PERL_EXPORT_C SSize_t   PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
 PERL_EXPORT_C void      PerlIOBase_setlinebuf(pTHX_ PerlIO *f);
 PERL_EXPORT_C SSize_t   PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);

diff --git a/pod/perliol.pod b/pod/perliol.pod
index e814847..0f71b93 100644 (file)
--- a/pod/perliol.pod
+++ b/pod/perliol.pod
@@ -526,11 +526,12 @@ passed to C<open>, otherwise it will be 1 if for example
 C<PerlIO_open> was called.  In simple cases SvPV_nolen(*args) is the
 pathname to open.
 
-Having said all that translation-only layers do not need to provide
-C<Open()> at all, but rather leave the opening to a lower level layer
-and wait to be "pushed".  If a layer does provide C<Open()> it should
-normally call the C<Open()> method of next layer down (if any) and
-then push itself on top if that succeeds.
+If a layer provides C<Open()> it should normally call the C<Open()>
+method of next layer down (if any) and then push itself on top if that
+succeeds.  C<PerlIOBase_open> is provided to do exactly that, so in
+most cases you don't have to write your own C<Open()> method.  If this
+method is not defined, other layers may have difficulty pushing
+themselves on top of it during open.
 
 If C<PerlIO_push> was performed and open has failed, it must
 C<PerlIO_pop> itself, since if it's not, the layer won't be removed