From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Tue, 9 Jul 2002 17:13:41 +0000 (+0000)
Subject: Tidy PerlIO::Via
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=30ef33217aeee51ee47b2433e9384b011646254a;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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;
 }
+