[win32] document CORE::GLOBAL:: and global overriding, fix up

File::DosGlob, testsuited and all

p4raw-id: //depot/win32/perl@1072

diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index a27dad9..24b28b2 100644 (file)
--- a/lib/File/DosGlob.pm
+++ b/lib/File/DosGlob.pm
@@ -130,10 +130,10 @@ sub glob {
 
 sub import {
     my $pkg = shift;
-    my $callpkg = caller(0);
+    return unless @_;
     my $sym = shift;
-    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym}
-       if defined($sym) and $sym eq 'glob';
+    my $callpkg = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
+    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
 }
 
 1;
@@ -151,6 +151,9 @@ File::DosGlob - DOS like globbing and then some
     # override CORE::glob in current package
     use File::DosGlob 'glob';
     
+    # override CORE::glob in ALL packages (use with extreme caution!)
+    use File::DosGlob 'GLOBAL_glob';
+
     @perlfiles = glob  "..\\pe?l/*.p?";
     print <..\\pe?l/*.p?>;
     
@@ -192,6 +195,10 @@ Gurusamy Sarathy <gsar@umich.edu>
 
 =item *
 
+Support for globally overriding glob() (GSAR 3-JUN-98)
+
+=item *
+
 Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
 
 =item *

diff --git a/pod/perlsub.pod b/pod/perlsub.pod
index 7212bb5..1d7660c 100644 (file)
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -932,9 +932,59 @@ and it would import the open override, but if they said
 
 they would get the default imports without the overrides.
 
-Note that such overriding is restricted to the package that requests
-the import.  Some means of "globally" overriding builtins may become
-available in future.
+The foregoing mechanism for overriding builtins is restricted, quite
+deliberately, to the package that requests the import.  There is a second
+method that is sometimes applicable when you wish to override a builtin
+everywhere, without regard to namespace boundaries.  This is achieved by
+importing a sub into the special namespace C<CORE::GLOBAL::>.  Here is an
+example that quite brazenly replaces the C<glob> operator with something
+that understands regular expressions.
+
+    package REGlob;
+    require Exporter;
+    @ISA = 'Exporter';
+    @EXPORT_OK = 'glob';
+
+    sub import {
+       my $pkg = shift;
+       return unless @_;
+       my $sym = shift;
+       my $where = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
+       $pkg->export($where, $sym, @_);
+    }
+
+    sub glob {
+       my $pat = shift;
+       my @got;
+       local(*D);
+       if (opendir D, '.') { @got = grep /$pat/o, readdir D; closedir D; }
+       @got;
+    }
+    1;
+
+And here's how it could be (ab)used:
+
+    #use REGlob 'GLOBAL_glob';     # override glob() in ALL namespaces
+    package Foo;
+    use REGlob 'glob';             # override glob() in Foo:: only
+    print for <^[a-z_]+\.pm\$>;            # show all pragmatic modules
+
+Note that the initial comment shows a contrived, even dangerous example.
+By overriding C<glob> globally, you would be forcing the new (and
+subversive) behavior for the C<glob> operator for B<every> namespace,
+without the complete cognizance or cooperation of the modules that own
+those namespaces.  Naturally, this should be done with extreme caution--if
+it must be done at all.
+
+The C<REGlob> example above does not implement all the support needed to
+cleanly override perl's C<glob> operator.  The builtin C<glob> has
+different behaviors depending on whether it appears in a scalar or list
+context, but our C<REGlob> doesn't.  Indeed, many perl builtins have such
+context sensitive behaviors, and these must be adequately supported by
+a properly written override.  For a fully functional example of overriding
+C<glob>, study the implementation of C<File::DosGlob> in the standard
+library.
+
 
 =head2 Autoloading
 

diff --git a/t/lib/dosglob.t b/t/lib/dosglob.t
index 7398a14..577d4ea 100755 (executable)
--- a/t/lib/dosglob.t
+++ b/t/lib/dosglob.t
@@ -9,7 +9,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..9\n";
+print "1..10\n";
 
 # override it in main::
 use File::DosGlob 'glob';
@@ -92,3 +92,21 @@ while (<*/a*.t>) {
 print "not " if "@r" ne "@s";
 print "ok 9\n";
 
+# how about a global override, hm?
+eval <<'EOT';
+use File::DosGlob 'GLOBAL_glob';
+package Bar;
+@s = ();
+while (<*/a*.t>) {
+    my $i = 0;
+    print "# $_ <";
+    push @s, $_;
+    while (glob '*/b*.t') {
+        print " $_";
+       $i++;
+    }
+    print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 10\n";
+EOT