From: Dave Rolsky <autarch@urth.org>
Date: Thu, 14 Oct 2010 19:46:36 +0000 (-0500)
Subject: Allow regexes in -ignore parameter
X-Git-Tag: v0.06~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FPackage-DeprecationManager.git;a=commitdiff_plain;h=e546f61d6bd97fad9857cdd34a00cd5906190074

Allow regexes in -ignore parameter
---

diff --git a/lib/Package/DeprecationManager.pm b/lib/Package/DeprecationManager.pm
index a0fa4a0..ba85924 100644
--- a/lib/Package/DeprecationManager.pm
+++ b/lib/Package/DeprecationManager.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use Carp qw( croak );
+use List::MoreUtils qw( any );
 use Params::Util qw( _HASH );
 use Sub::Install;
 
@@ -62,7 +63,8 @@ sub _build_warn {
     my $deprecated_at = shift;
     my $ignore        = shift;
 
-    my %ignore = map { $_ => 1 } @{ $ignore || [] };
+    my %ignore = map { $_ => 1 } grep { !ref } @{ $ignore || [] };
+    my @ignore_res = grep {ref} @{ $ignore || [] };
 
     my %warned;
 
@@ -71,12 +73,13 @@ sub _build_warn {
 
         my ( $package, undef, undef, $sub ) = caller(1);
 
-        # We want to start two levels back, since we already looked
-        # one level back and found an internal package.
         my $skipped = 1;
+
         if ( keys %ignore ) {
-            while ( defined $package && $ignore{$package} ) {
-                $package = caller($skipped++);
+            while ( defined $package
+                && ( $ignore{$package} || any { $package =~ $_ } @ignore_res )
+                ) {
+                $package = caller( $skipped++ );
             }
         }
 
@@ -180,10 +183,11 @@ deprecated. However, the feature names can be any string. This is useful if
 you don't want to deprecate an entire subroutine, just a certain usage.
 
 You can also provide an optional array reference in the C<-ignore>
-parameter. This is a list of package names to ignore when looking at the stack
-to figure out what code used the deprecated feature. This should be packages
-in your distribution that can appear on the call stack when a deprecated
-feature is used.
+parameter.
+
+The values to be ignored can be package names or regular expressions (made
+with C<qr//>).  Use this to ignore packages in your distribution that can
+appear on the call stack when a deprecated feature is used.
 
 As part of the import process, C<Package::DeprecationManager> will export two
 subroutines into its caller. It provides an C<import()> sub for the caller and a
diff --git a/t/basic.t b/t/basic.t
index 9538d92..fdf4140 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -168,10 +168,24 @@ use Test::Requires {
 }
 
 {
+    package Dep3;
+
+    use Package::DeprecationManager -deprecations => {
+        'baz' => '1.00',
+        },
+        -ignore => [ qr/My::Package[12]/ ];
+
+    sub baz {
+        deprecated('baz is deprecated');
+    }
+}
+
+{
     package My::Package1;
 
     sub foo { Dep::foo() }
     sub bar { Dep2::bar() }
+    sub baz { Dep3::baz() }
 }
 
 {
@@ -179,18 +193,23 @@ use Test::Requires {
 
     sub foo { My::Package1::foo() }
     sub bar { My::Package1::bar() }
+    sub baz { My::Package1::baz() }
 }
 
 {
     package My::Baz;
 
+    ::warning_like{ My::Package1::bar() }
+        qr/^bar is deprecated at t.basic\.t line \d+/,
+        'deprecation warning for call to My::Package1::bar()';
+
     ::warning_like{ My::Package2::foo() }
         qr/^foo is deprecated at t.basic\.t line \d+/,
         'deprecation warning for call to My::Package2::foo()';
 
-    ::warning_like{ My::Package1::bar() }
-        qr/^bar is deprecated at t.basic\.t line \d+/,
-        'deprecation warning for call to My::Package1::bar()';
+    ::warning_like{ My::Package1::baz() }
+        qr/^baz is deprecated at t.basic\.t line \d+/,
+        'deprecation warning for call to My::Package2::foo()';
 }
 
 {