Tidy PerlIO::Via

 - add test for open fail
 - add PerlIO_debug() diags to open paths
 - comments on API gaps
 - Update OPEN,SYSOPEN,FDOPEN pod entries.

p4raw-id: //depot/perlio@17447

diff --git a/ext/PerlIO/Via/Via.pm b/ext/PerlIO/Via/Via.pm
index eabae16..7f3938a 100644 (file)
--- a/ext/PerlIO/Via/Via.pm
+++ b/ext/PerlIO/Via/Via.pm
@@ -43,13 +43,20 @@ Should return an object or the class, or -1 on failure.  (Compare
 TIEHANDLE.)  The arguments are an optional mode string ("r", "w",
 "w+", ...) and a filehandle for the PerlIO layer below.  Mandatory.
 
+When layer is pushed as part of an C<open> call, C<PUSHED> will be called 
+I<before> the actual open occurs whether than be via C<OPEN>, C<SYSOPEN>,
+C<FDOPEN> or by letting lower layer do the open. 
+
 =item $obj->POPPED([$fh])
 
 Optional - layer is about to be removed.
 
-=item $class->OPEN($path,$mode[,$fh])
+=item $obj->OPEN($path,$mode[,$fh])
 
-Not yet in use.
+Optional - if not present lower layer does open.
+If present called for normal opens after layer is pushed.
+This function is subject to change as there is no easy way 
+to get lower layer to do open and then regain control.
 
 =item $obj->BINMODE([,$fh])
 
@@ -57,13 +64,21 @@ Optional - if not available layer is popped on binmode($fh) or when C<:raw>
 is pushed. If present it should return 0 on success -1 on error and undef
 to pop the layer.
 
-=item $class->FDOPEN($fd)
+=item $obj->FDOPEN($fd[,$fh])
 
-Not yet in use.
+Optional - if not present lower layer does open.
+If present called for opens which pass a numeric file 
+descriptor after layer is pushed. 
+This function is subject to change as there is no easy way 
+to get lower layer to do open and then regain control.
 
-=item $class->SYSOPEN($path,$imode,$perm,$fh)
+=item $obj->SYSOPEN($path,$imode,$perm,[,$fh])
 
-Not yet in use.
+Optional - if not present lower layer does open.
+If present called for sysopen style opens which pass a numeric mode 
+and permissions after layer is pushed.
+This function is subject to change as there is no easy way 
+to get lower layer to do open and then regain control.
 
 =item $obj->FILENO($fh)
 
@@ -186,3 +201,5 @@ on the fly back into bytes:
 =cut
 
 
+
+

diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs
index faa02e5..fb6718d 100644 (file)
--- a/ext/PerlIO/Via/Via.xs
+++ b/ext/PerlIO/Via/Via.xs
@@ -97,6 +97,7 @@ PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
        }
        else {
            PerlIO_debug("No next\n");
+           /* FIXME: How should this work for OPEN etc? */
        }
        PUTBACK;
        count = call_sv((SV *) cv, flags);
@@ -256,15 +257,20 @@ PerlIOVia_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers,
                            f = NULL;
                        }
                    }
+                   /* FIXME - Call an OPENED method here ? */
                    return f;
                }
                else {
+                   PerlIO_debug("Open fail %s => %p->%p\n", tab->name,
+                                PerlIONext(f), *PerlIONext(f));
                    /* Sub-layer open failed */
                }
            }
            else {
+                PerlIO_debug("Nothing to open with");
                /* Nothing to do the open */
            }
+           PerlIO_pop(aTHX_ f);
            return NULL;
        }
     }
@@ -601,3 +607,6 @@ BOOT:
 }
 
 
+
+
+

diff --git a/ext/PerlIO/t/via.t b/ext/PerlIO/t/via.t
index bd8923d..9fe699f 100644 (file)
--- a/ext/PerlIO/t/via.t
+++ b/ext/PerlIO/t/via.t
@@ -14,7 +14,7 @@ BEGIN {
 
 my $tmp = "via$$";
 
-use Test::More tests => 15;
+use Test::More tests => 16;
 
 my $fh;
 my $a = join("", map { chr } 0..255) x 10;
@@ -22,6 +22,7 @@ my $b;
 
 BEGIN { use_ok('MIME::QuotedPrint'); }
 
+ok( !open($fh,"<Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint fails');
 ok( open($fh,">Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint for output');
 ok( (print $fh $a), "print to output file");
 ok( close($fh), 'close output file');
@@ -76,3 +77,4 @@ is( $obj, 'PerlIO::Via::Bar', 'search for package PerlIO::Via::Bar' );
 END {
     1 while unlink $tmp;
 }
+