Refactor PR garu#74 to void PPI dependency.

Pull request garu#74 'show variable name as __VAR__' had a dependency on
the PPI module which made its inclusion in the master less atractive
for the users not using the feature. By refactoring the part of the
code that depended on PPI out in a separate module, only the users
that would like to use the feature needs to install PPI.

The code remaining in master (that does not depend on PPI) now implements
a plugin hook in the write_label() sub in Data::Printer::Object. An
option in the configuration file called 'caller_plugin' is used to
register a caller plugin. If such a plugin is registered,
write_label() will load the plugin and then call the plugin to do the
generation of the label string.

The refactored part of garu#74 that depends on PPI has been included in
the module Data::Printer::Plugin::Caller::PPI (currently on Github).

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');

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