Refactor PR #74 to avoid dependency on the PPI module.

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;
     }

lib/Data/Printer/Object.pm

@@ -64,7 +64,7 @@ use Data::Printer::Filter::GenericClass;
 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
+    caller_info caller_message caller_message_newline caller_plugin caller_message_position
     string_max string_overflow string_preserve resolve_scalar_refs
     array_max array_overflow array_preserve hash_max hash_overflow
     hash_preserve unicode_charnames colored theme show_weak
@@ -156,6 +156,7 @@ sub _init {
     $self->{'caller_message_newline'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'caller_message_newline', 1);
     $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->{'caller_plugin'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'caller_plugin', undef);
     $self->{'string_max'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'string_max', 4096);
     $self->{'string_preserve'} = Data::Printer::Common::_fetch_anyof(
                              $props,
@@ -763,10 +764,29 @@ sub _write_label {
     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');
@@ -1018,6 +1038,11 @@ When true, skips a line when printing L<caller_message|/caller_message>.
 When false, only a single space is added between the message and the data.
 (default: 1)
 
+=head3 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.
+
 =head3 caller_message_position
 
 This option controls where the L<caller_message|/caller_message> will appear

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;
+}