summaryrefslogtreecommitdiff
path: root/ext/PerlIO
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2002-07-01 18:25:22 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2002-07-01 18:25:22 +0000
commit52f3c1af8670f243c94919af003c622c61f1ce6f (patch)
treeb098c064a7a9a8ab5c142d4333fbf7d57a2f0b8c /ext/PerlIO
parent1acdb0da20c8b57ef4b35c7c1b7e0ed3fc417368 (diff)
downloadperl-52f3c1af8670f243c94919af003c622c61f1ce6f.tar.gz
Allow PerlIO::Via to look for modules in the default
namespace PerlIO::Via::. p4raw-id: //depot/perl@17393
Diffstat (limited to 'ext/PerlIO')
-rw-r--r--ext/PerlIO/Via/Via.pm5
-rw-r--r--ext/PerlIO/Via/Via.xs6
-rw-r--r--ext/PerlIO/t/via.t10
3 files changed, 20 insertions, 1 deletions
diff --git a/ext/PerlIO/Via/Via.pm b/ext/PerlIO/Via/Via.pm
index 92614b4b0a..eabae16d25 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 04c4d48906..0917a36d65 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 43ea3c5a95..bd8923db37 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;
}