From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 23 Feb 2009 10:27:08 +0000 (+0100)
Subject: Add deprecate.pm. Deprecate shipping Switch.pm in the core distribution.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e76b2c0c0a5a6bcf7f940f55f050b6f3cecac437;p=p5sagit%2Fp5-mst-13.2.git

Add deprecate.pm. Deprecate shipping Switch.pm in the core distribution.
---

diff --git a/MANIFEST b/MANIFEST
index cfa871e..ca5213f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1940,6 +1940,7 @@ lib/DBM_Filter/utf8.pm		DBM Filter for UTF-8 Encoding
 lib/dbm_filter_util.pl		Utility functions used by DBM Filter tests
 lib/DB.pm			Debugger API (draft)
 lib/DB.t			See if DB works
+lib/deprecate.pm		A pragma for deprecating modules from the core.
 lib/Devel/SelfStubber.pm	Generate stubs for SelfLoader.pm
 lib/Devel/SelfStubber.t		See if Devel::SelfStubber works
 lib/diagnostics.pm		Print verbose diagnostics
diff --git a/lib/Switch.pm b/lib/Switch.pm
index 709442e..8e98d29 100644
--- a/lib/Switch.pm
+++ b/lib/Switch.pm
@@ -4,8 +4,10 @@ use strict;
 use vars qw($VERSION);
 use Carp;
 
-$VERSION = '2.14';
+use if $] >= 5.011, 'deprecate';
 
+$VERSION = '2.14_01';
+  
 
 # LOAD FILTERING MODULE...
 use Filter::Util::Call;
diff --git a/lib/deprecate.pm b/lib/deprecate.pm
new file mode 100644
index 0000000..23c045b
--- /dev/null
+++ b/lib/deprecate.pm
@@ -0,0 +1,40 @@
+#!perl -w
+use strict;
+
+package deprecate;
+use Config;
+use Carp;
+use warnings;
+our $VERSION = 0.01;
+
+sub import {
+    my ($package, $file, $line) = caller;
+    my $expect_leaf = "$package.pm";
+    $expect_leaf =~ s!::!/!g;
+
+    foreach my $pair ([qw(sitearchexp archlibexp)],
+		      [qw(sitelibexp privlibexp)]) {
+	my ($site, $priv) = @Config{@$pair};
+	# Just in case anyone managed to configure with trailing /s
+	s!/*$!!g foreach $site, $priv;
+
+	next if $site eq $priv;
+	if ("$priv/$expect_leaf" eq $file) {
+	    # This is fragile, because it
+	    # 1: depends on the number of call stacks in if.pm
+	    # 2: is directly poking in the internals of warnings.pm
+	    my ($call_file, $call_line, $callers_bitmask) = (caller 3)[1,2,9];
+
+	    if (defined $callers_bitmask
+            	&& (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1)
+		    || vec($callers_bitmask, $warnings::Offsets{all}, 1))) {
+		warn <<"EOM";
+$package will be removed from the Perl core distribution in the next major release. Please install it from CPAN. It is being used at $call_file line $call_line
+EOM
+	    }
+	    return;
+	}
+    }
+}
+
+1;