diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2002-07-01 18:25:22 +0000 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2002-07-01 18:25:22 +0000 |
commit | 52f3c1af8670f243c94919af003c622c61f1ce6f (patch) | |
tree | b098c064a7a9a8ab5c142d4333fbf7d57a2f0b8c /ext/PerlIO | |
parent | 1acdb0da20c8b57ef4b35c7c1b7e0ed3fc417368 (diff) | |
download | perl-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.pm | 5 | ||||
-rw-r--r-- | ext/PerlIO/Via/Via.xs | 6 | ||||
-rw-r--r-- | ext/PerlIO/t/via.t | 10 |
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; } |