From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 1 Jul 2002 18:25:22 +0000 (+0000)
Subject: Allow PerlIO::Via to look for modules in the default
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52f3c1af8670f243c94919af003c622c61f1ce6f;p=p5sagit%2Fp5-mst-13.2.git

Allow PerlIO::Via to look for modules in the default
namespace PerlIO::Via::.

p4raw-id: //depot/perl@17393
---

diff --git a/ext/PerlIO/Via/Via.pm b/ext/PerlIO/Via/Via.pm
index 92614b4..eabae16 100644
--- a/ext/PerlIO/Via/Via.pm
+++ b/ext/PerlIO/Via/Via.pm
@@ -15,6 +15,11 @@ PerlIO::Via - Helper class for PerlIO layers implemented in perl
 
    open($fh,"<:Via(Some::Package)",...);
 
+   use PerlIO::Via::SomeLayer;
+
+   # Assume PerlIO::Via:: default namespace when SomeLayer.pm is not found
+   open($fh,"<:Via(SomeLayer)",...);
+
 =head1 DESCRIPTION
 
 The package to be used as a layer should implement at least some of the
diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs
index 04c4d48..0917a36 100644
--- a/ext/PerlIO/Via/Via.xs
+++ b/ext/PerlIO/Via/Via.xs
@@ -142,6 +142,12 @@ PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
      char *pkg = SvPV(arg,pkglen);
      s->obj = SvREFCNT_inc(arg);
      s->stash  = gv_stashpvn(pkg, pkglen, FALSE);
+     if (!s->stash)
+      {
+       s->obj = newSVpvn(Perl_form(aTHX_ "PerlIO::Via::%s",pkg), pkglen + 13);
+       SvREFCNT_dec(arg);
+       s->stash = gv_stashpvn(SvPVX(s->obj), pkglen + 13, FALSE);
+      }
      if (s->stash)
       {
        SV *modesv = (mode) ? sv_2mortal(newSVpvn(mode,strlen(mode))) : Nullsv;
diff --git a/ext/PerlIO/t/via.t b/ext/PerlIO/t/via.t
index 43ea3c5..bd8923d 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 => 13;
+use Test::More tests => 15;
 
 my $fh;
 my $a = join("", map { chr } 0..255) x 10;
@@ -65,6 +65,14 @@ is($a, $b, 'compare original data with filtered version');
     is( $warnings, "",  "don't warn about unknown package" );
 }
 
+my $obj = '';
+sub Foo::PUSHED			{ $obj = shift; -1; }
+sub PerlIO::Via::Bar::PUSHED	{ $obj = shift; -1; }
+open $fh, '<:Via(Foo)', "foo";
+is( $obj, 'Foo', 'search for package Foo' );
+open $fh, '<:Via(Bar)', "bar";
+is( $obj, 'PerlIO::Via::Bar', 'search for package PerlIO::Via::Bar' );
+
 END {
     1 while unlink $tmp;
 }