Merge ed857aa into 04631d9

lib/Data/Printer.pm

@@ -37,6 +37,7 @@ sub import {
     my $imported = _find_option('alias', $args, $caller, 'p');
 
     { no strict 'refs';
+      no warnings 'redefine';
         *{"$caller\::$imported"} = $exported;
         *{"$caller\::np"}        = \&np;
     }
@@ -563,6 +564,7 @@ each of them:
     end_separator  = 0
     caller_info    = 0
     caller_message = 'Printing in line __LINE__ of __FILENAME__'
+    caller_plugin  = none
     max_depth      = 0
     deparse        = 0
     alias          = p

lib/Data/Printer/Object.pm

@@ -63,7 +63,7 @@ my @method_names =qw(
     name show_tainted show_unicode show_readonly show_lvalue show_refcount
     show_memsize memsize_unit print_escapes scalar_quotes escape_chars
     caller_info caller_message caller_message_newline caller_message_position
-    string_max string_overflow string_preserve resolve_scalar_refs
+    string_max string_overflow string_preserve resolve_scalar_refs caller_plugin
     array_max array_overflow array_preserve hash_max hash_overflow
     hash_preserve unicode_charnames colored theme show_weak
     max_depth index separator end_separator class_method class hash_separator
@@ -155,6 +155,7 @@ sub _init {
     $self->{'caller_message_position'} = Data::Printer::Common::_fetch_anyof($props, 'caller_message_position', 'before', [qw(before after)]);
     $self->{'resolve_scalar_refs'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'resolve_scalar_refs', 0);
     $self->{'string_max'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'string_max', 4096);
+    $self->{'caller_plugin'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'caller_plugin', undef);
     $self->{'string_preserve'} = Data::Printer::Common::_fetch_anyof(
                              $props,
                              'string_preserve',
@@ -754,12 +755,30 @@ sub _write_label {
     my ($self) = @_;
     return '' unless $self->caller_info;
     my @caller = caller 1;
-
     my $message = $self->caller_message;
-
-    $message =~ s/\b__PACKAGE__\b/$caller[0]/g;
-    $message =~ s/\b__FILENAME__\b/$caller[1]/g;
-    $message =~ s/\b__LINE__\b/$caller[2]/g;
+    if ( $self->caller_plugin ) {
+        my $name = "Data::Printer::Plugin::Caller::" . $self->caller_plugin;
+        my $req_name = $name;
+        $req_name =~ s{::}{/}g;
+        eval {
+            require "${req_name}.pm";
+        };
+        if ($@) {
+            warn "$@";
+            warn "Failed to load caller plugin: $name\n";
+            warn "Maybe you need to install the module?\n";
+            return "";
+        }
+        my $plugin = $name->new(
+            parent => $self, template => $message, caller => \@caller
+        );
+        $message = $plugin->get_message();
+    }
+    else {
+        $message =~ s/\b__PACKAGE__\b/$caller[0]/g;
+        $message =~ s/\b__FILENAME__\b/$caller[1]/g;
+        $message =~ s/\b__LINE__\b/$caller[2]/g;
+    }
 
     my $separator = $self->caller_message_newline ? "\n" : ' ';
     $message = $self->maybe_colorize($message, 'caller_info');
@@ -1218,6 +1237,10 @@ according to its inheritance. Can be set to 1 (always show), 0 (never show)
 or 'auto', which shows only when the object has more than one superclass.
 (default: 'auto')
 
+=head4 caller_plugin 
+
+Name of caller plugin (default: undef). If you specify a name, e.g. c<PPI>, it will use c<Data::Printer::Plugin::Caller::PPI> to print the caller information label.
+
 =head4 universal
 
 Set this option to 1 to include UNIVERSAL methods to the list of public

t/025-caller_plugin.t

@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+    use Data::Printer::Config;
+    no warnings 'redefine';
+    *Data::Printer::Config::load_rc_file = sub { {} };
+};
+
+use Data::Printer colored        => 0,
+                  use_prototypes => 0,
+                  caller_info    => 1,
+                  caller_plugin  => 'Foo';
+
+if (!eval { require Capture::Tiny; 1; }) {
+    plan skip_all => 'Capture::Tiny not found';
+}
+else {
+    plan tests => 1;
+}
+
+{
+    # Try to force require(..) for a caller plugin to fail..
+
+    # In the case the user by chance should have installed a module with
+    # the same name as the caller plugin, make sure it will not be found
+    # by erasing @INC :
+    local @INC = ('./lib');
+
+    # NOTE: local $INC{'Data/Printer/Plugin/Caller/Foo.pm'} does not work
+    #  it just sets $INC{'Data/Printer/Plugin/Caller/Foo.pm'} to undef
+    #  but that is enough for require "Data/Printer/Plugin/Caller/Foo.pm" not
+    #  to fail, so we have to delete the key (and the value):
+    my $save = delete $INC{'Data/Printer/Plugin/Caller/Foo.pm'};
+    my $var = 1;
+    my ($stdout, $stderr) = Capture::Tiny::capture(
+        sub {
+            p \$var, output => *STDOUT;
+        }
+    );
+    like $stderr, qr/Failed to load caller plugin/, 'missing plugin';
+    $INC{'Data/Printer/Plugin/Caller/Foo.pm'} = $save if defined $save;
+}