Small pod fix

[gitmo/Package-DeprecationManager.git] / lib / Package / DeprecationManager.pm

diff --git a/lib/Package/DeprecationManager.pm b/lib/Package/DeprecationManager.pm
index ee370bd..e82da33 100644 (file)
--- 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,13 +73,13 @@ sub _build_warn {
 
         my ( $package, undef, undef, $sub ) = caller(1);
 
-        my $skipped = 0;
-        if ( keys %ignore ) {
-            while ( defined $package && $ignore{$package} ) {
-                # We want to start two levels back, since we already looked
-                # one level back and found an internal package.
-                $package = caller($skipped++ + 2);
-                $skipped++;
+        my $skipped = 1;
+
+        if ( @ignore_res || keys %ignore ) {
+            while ( defined $package
+                && ( $ignore{$package} || any { $package =~ $_ } @ignore_res )
+                ) {
+                $package = caller( $skipped++ );
             }
         }
 
@@ -96,8 +98,6 @@ sub _build_warn {
                 && defined $deprecated_at
                 && $compat_version lt $deprecated_at;
 
-        return if $warned{$package}{ $args{feature} };
-
         my $msg;
         if ( defined $args{message} ) {
             $msg = $args{message};
@@ -108,9 +108,13 @@ sub _build_warn {
                 if defined $deprecated_at;
         }
 
-        $warned{$package}{ $args{feature} } = 1;
+        return if $warned{$package}{ $args{feature} }{$msg};
 
-        local $Carp::CarpLevel = $Carp::CarpLevel + 1 + $skipped;
+        $warned{$package}{ $args{feature} }{$msg} = 1;
+
+        # We skip at least two levels. One for this anon sub, and one for the
+        # sub calling it.
+        local $Carp::CarpLevel = $Carp::CarpLevel + $skipped;
 
         Carp::cluck($msg);
     };
@@ -179,21 +183,22 @@ 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 proves an C<import()> sub for the caller and a
+subroutines into its caller. It provides an C<import()> sub for the caller and a
 C<deprecated()> sub.
 
 The C<import()> sub allows callers of I<your> class to specify an C<-api_version>
 parameter. If this is supplied, then deprecation warnings are only issued for
 deprecations for api versions earlier than the one specified.
 
-You must call C<deprecated()> sub in each deprecated subroutine. When called,
-it will issue a warning using C<Carp::cluck()>.
+You must call the C<deprecated()> sub in each deprecated subroutine. When
+called, it will issue a warning using C<Carp::cluck()>.
 
 The C<deprecated()> sub can be called in several ways. If you do not pass any
 arguments, it will generate an appropriate warning message. If you pass a
@@ -206,8 +211,10 @@ to the feature name passed in the C<-deprecations> hash.
 If you don't explicitly specify a feature, the C<deprecated()> sub uses
 C<caller()> to identify its caller, using its fully qualified subroutine name.
 
-Deprecation warnings are only issued once for a given package, regardless of
-how many times the deprecated sub/method is called.
+A given deprecation warning is only issued once for a given package. This
+module tracks this based on both the feature name I<and> the error message
+itself. This means that if you provide severaldifferent error messages for the
+same feature, all of those errors will appear.
 
 =head1 BUGS