File Coverage

blib/lib/Data/Show.pm

Criterion	Covered	Total	%
statement	266	315	84.4
branch	74	124	59.6
condition	28	77	36.3
subroutine	53	58	91.3
pod	1	3	33.3
total	422	577	73.1

package Data::Show;

=encoding utf-8
=cut

use 5.010;
use strict;
use warnings;
use utf8;
use PPR;

our $VERSION = '0.004002';

# Be a ninja...
our @CARP_NOT;

# Useful pieces of information...
my $IS_UTF8_TERM;  BEGIN { $IS_UTF8_TERM  = grep {$_ && /utf-8/i} @ENV{qw}; }
my $IS_LIGHT_BG;   BEGIN { $IS_LIGHT_BG   = ($ENV{COLORFGBG} // q{}) =~ m{\A 0;15 \z}x;          }
my $CAN_ANSICOLOR; BEGIN { $CAN_ANSICOLOR = eval { require Term::ANSIColor; 1 } ? 1 : 0;         }

# Various defaults...
my $MAXWIDTH;               BEGIN { $MAXWIDTH  = 78;                                                  }
my $INITIAL_DEFAULT_PLUGIN; BEGIN { $INITIAL_DEFAULT_PLUGIN = 'Data::Show::Plugin::Data::Pretty';     }
my $FINAL_CANDIDATE_PLUGIN; BEGIN { $FINAL_CANDIDATE_PLUGIN = 'Data::Show::Plugin';                   }
my $DEFAULT_TARGET;         BEGIN { $DEFAULT_TARGET         = \*STDERR;                               }
my $RC_FILE_NAME;           BEGIN { $RC_FILE_NAME           = '.datashow';                            }
my @PLUGIN_API;             BEGIN { @PLUGIN_API = qw< stringify format >;    }
my @ARGUMENT_DEFAULTS;      BEGIN { @ARGUMENT_DEFAULTS = (
                                      to         => $DEFAULT_TARGET,
                                      with       => $INITIAL_DEFAULT_PLUGIN,
                                      as         => 'show',
                                      fallback   => q{},
                                      warnings   => 'off',
                                      termwidth  => $MAXWIDTH,

                                      grid       => 'off',
                                      style      => 'auto',

                                                   # DARK BACKGROUND    LIGHT BACKGROUND
                                      showstyle  => 'bold bright_cyan , bold bright_blue',
                                      datastyle  =>       'bold white ,       bold black',
                                      codestyle  =>             'cyan ,             blue',
                                      filestyle  =>             'blue ,              red',
                                      linestyle  =>             'blue ,              red',
                                      gridstyle  =>             'blue ,              red',
                                    );
                            }
my %GRID; BEGIN {
    @GRID{split //,                   q{┏┯┓┗┷┛━┃┠─┬┴┨│} }
        = split //, ( $IS_UTF8_TERM ? q{┏┯┓┗┷┛━┃┠─┬┴┨│}
                                    : q{ _ |_|_||---|:}
        );
}


# Useful regexes...
my $OWS;         BEGIN { $OWS         = qr{ (?: \s++ | \# [^\n]*+ )*+ }x;               }
my $IDENT;       BEGIN { $IDENT       = qr{ [^\W\d]\w* (?: :: [^\W\d]\w* )* | [_\W] }x; }
my $COLOUR_CHAR; BEGIN { $COLOUR_CHAR = qr{ (?: \e[^m]*m )*  [^\n]  (?: \e[^m]*m )* }x; }
my $VALID_ARG;   BEGIN { $VALID_ARG   = qr{ \A (?: to        | with      | fallback
                                                 | base      | warnings  | as
                                                 | style     | grid      | termwidth
                                                 | datastyle | filestyle | linestyle
                                                 | codestyle | showstyle | gridstyle
                                               ) \z }x; }

# Track lexically scoped output targets and styles...
my @OUTPUT_FH;
my @STYLE;

# Export the module's API, or that of a plugin (as requested)...
sub import {
    # Track load context...
    my ($package, $file, $line) = _get_context();

    # Remove the module name from the argument list...
    shift @_;

    # Handle the special case of a 'base' argument (by adding it as the caller's base class)...
    if (@_ > 0 && $_[0] eq 'base') {
        die "If 'base' is specified, it must be the only argument at $file line $line\n" if @_ > 2;
        no strict 'refs';
        push @{caller().'::ISA'}, _load_plugin( $_[1] // 'Data::Show::Plugin', $file, $line, 'warn' );
        return;
    }

    # Check for missing named args and improve the usual warning for that problem...
    die "No value specified for named argument '$_[-1]' at $file line $line\n"
        if @_ % 2 != 0;

    # Unpack args (including defaults from config file)....
    state $defaults_ref = _load_defaults($file, $line);
    my %opt = (%{$defaults_ref}, @_);

    # Punish invalid arguments...
    _validate_args(\%opt, "at $file line $line", "named argument");

    # Any 'to' arg must be a filehandle, filename, or scalar ref (and open it if necessary)...
    $opt{to} = _open_target( $opt{to} // $DEFAULT_TARGET, $file, $line, $opt{warnings} ne 'off' );

    # Unpack fallback arguments into an arrayref...
    $opt{fallback} = [ split m{ \s*,\s* }x, $opt{fallback} ];

    # Resolve style options according to terminal background (i.e. dark or light)
    for my $option (@opt{ grep /\A.+style\z/, keys %opt}) {
        $option = [split /\s*,\s*/, $option]->[$IS_LIGHT_BG ? -1 : 0];
    }

    # Install Data::Show::Plugin base class as well...
    $INC{'Data/Show/Plugin.pm'} = $INC{'Data/Show.pm'};

    # Track lexical options...
    $^H{'Data::Show/with'}       = _load_plugin( $opt{with}, $file, $line,
                                                 $opt{warnings} ne 'off', $opt{fallback} );
    $^H{'Data::Show/termwidth'}  = $opt{termwidth};
    $^H{'Data::Show/to'}         = @OUTPUT_FH;
    $^H{'Data::Show/style'}      = @STYLE;
    my $existing_as              = $^H{'Data::Show/as'} // '(?!)';
    $^H{'Data::Show/as'}         = "$existing_as|$opt{as}";
    push @OUTPUT_FH, $opt{to};
    push @STYLE,     { add_grid => $opt{grid},
                       mode     => $opt{style},
                       map { m/(.+)style/ ? ($1 => $opt{$_}) : () } keys %opt
                     };

    # Install the function...
    no strict 'refs';
    *{caller() . '::' . $opt{as}} = \&show;
}

# A "no Data::Show" turns show() into a no-op...
sub unimport {
    # Track disabling lexically...
    $^H{'Data::Show/noshow'} = 1;

    # Install the function...
    no strict 'refs';
    *{caller() . '::show'} = \&show;
}

sub _validate_args {
    my ($opt_ref, $where, $what) = @_;

    # Collect and report non-valid arguments...
    my @unknown_args = grep { !m{$VALID_ARG} } keys %{$opt_ref};
    die "Unknown $what" . (@unknown_args == 1 ? '' : 's') . " $where:\n",
        join q{}, map { "    $_\n" } @unknown_args
            if @unknown_args;

    # By the time we're validating, we shouldn't see a 'base' option...
    return if !exists $opt_ref->{base};
    die $what eq 'named argument' ? "If 'base' is specified, it must be the only argument $where\n"
                                  : "Can't specify 'base' as a $what $where\n"
}

# Ensure output filehandles are valid (or fall back to the default)...
sub _open_target {
    my ($target, $file, $line, $warnings) = @_;

    # Track already opened targets, and reuse them...
    state %already_open;
    return $already_open{$target} if $already_open{$target};

    # Handle stringy filenames and in-memory targets...
    my $to_type = ref($target);
    if (!$to_type && ref(\$target) ne 'GLOB' || $to_type eq 'SCALAR') {
        if (open my $fh, '>', $target) {
            return ($already_open{$target} = $fh);
        }
        else {
            warn "Could not open named 'to' argument for output at $file line $line\n"
                if $warnings;
            return ($already_open{$target} = $DEFAULT_TARGET);
        }
    }

    # Handle filehandle-y targets...
    elsif (_is_writeable($target)) {
        return ($already_open{$target} = $target);
    }
    else {
        warn "Named 'to' argument is not a writeable target at $file line $line\n"
            if $warnings;
        return ($already_open{$target} = $DEFAULT_TARGET);
    }
}

# -w is not reliable, so do this instead...
sub _is_writeable {
    return eval { no warnings; print {$_[0]} q{} };
}


# Extract call context, adjusting for evals...
sub _get_context {
    # Start in the current caller's caller...
    my ($package, $file, $line, $hints_ref) = (caller(1))[0..2,10];

    # Keep looking up as long as next caller is a string eval...
    if ($file =~ m{\A \( eval \s+ \d+ \)}x) {
        for my $uplevel (2..1_000_000) {
            my ($uppackage, $upfile, $upline) = caller($uplevel);
            $upfile =~ s{.*/}{};
            $file .= ", at $upfile line $upline";
            last if $upfile !~ m{\A \( eval \s+ \d+ \)}x;
        }
    }

    return ($package, $file, $line, $hints_ref);
}

# Strip repeated arguments from return list...
sub _uniq {
    my %seen;
    return grep {!$seen{$_}++} @_;
}

# Load requested plugin (or fall back on a safe default)...
my %STANDARD_PLUGIN;   # (Populated below)
sub _load_plugin {
    my ($plugin, $file, $line, $warnings, $fallback_ref) = @_;

    # Build initial fallback list...
    my @fallbacks = _uniq( @{ $fallback_ref // [] } );

    # Remember and normalize the original plugin requested (even after we start falling back)...
    my $starting_plugin = $plugin;
    if ($starting_plugin !~ m{ \A Data::Show::Plugin \b }x) {
        $starting_plugin = "Data::Show::Plugin::$plugin";
    }

    # Track outcomes...
    my @failed_loads;
    state %loaded;

    # Loop to accommodate fallbacks (if required)...
    CANDIDATE:
    while (1) {
        # Normalize plugin name under the Data::Show::Plugin:: hierarchy...
        if ($plugin !~ m{ \A Data::Show::Plugin \b }x) {
            $plugin = "Data::Show::Plugin::$plugin";
        }

        # Only load (or try to load) each plugin once (if already loaded, just return its name)...
        last CANDIDATE if exists $loaded{$plugin};

        # Handle standard plugins...
        if (my $standard = $STANDARD_PLUGIN{$plugin}) {

            # Validate the plugin's preconditions...
            for my $requirement (@{$standard->{requires}}) {

                # If plugin can't be used, fall back to the next best alternative (if any)...
                if (!eval "require $requirement; 1") {
                    warn "$plugin requires $requirement, which could not be loaded.\n"
                        if $warnings;
                    push @failed_loads, $plugin;
                    if ($plugin = shift(@fallbacks) // $standard->{fallback}) {
                        next CANDIDATE;
                    }
                    else {
                        $plugin = $FINAL_CANDIDATE_PLUGIN;
                        last CANDIDATE;
                    }
                }
            }

            # Instantiate the plugin class, inserting the plugin-specific source code...
            eval qq{
                package $plugin;
                BEGIN { our \@ISA = 'Data::Show::Plugin'; }
                $standard->{source};
                1;
            } or die "Internal error: $@";   # This can never happen! ;-)

            # And we're done...
            last CANDIDATE;
        }

        # Otherwise, if we can load the (non-standard) module then we're also done...
        elsif (_load_external_plugin($plugin, $warnings)) {
            last CANDIDATE;
        }

        # Otherwise, fall back to a specified alternative, or else try the standard fallback(s)...
        else {
            warn "Could not install $plugin at $file line $line\n"
                if $warnings;
            push @failed_loads, $plugin;
            $plugin = shift(@fallbacks) // $INITIAL_DEFAULT_PLUGIN;
            next CANDIDATE;
        }
    }

    # Report substitution-on-failure (if any)...
    warn "Used $plugin in place of $starting_plugin at $file line $line\n"
        if $warnings && $plugin ne $starting_plugin;

    # Remember the outcome(s) to speed things up next time...
    $loaded{$_} = $plugin for $plugin, @failed_loads;

    return $plugin;
}

# Load or otherwise verify the availability of a non-standard plugin...
sub _load_external_plugin {
    my ($plugin, $warnings) = @_;

    # Load it (or fail silently)...
    eval "require $plugin";

    # Are all the essential methods present in the plugin class???
    my @missing_methods = grep { !$plugin->can($_) } @PLUGIN_API;
    warn "Requested plugin class $plugin does not provide the following essential methods:\n",
         (map { "   $_()" } @missing_methods), "\n"
            if $warnings && @missing_methods;

    # Succeed if all the essential methods are available...
    return !@missing_methods;
}

# Locate and process config file(s) and/or environment variable, if any...
sub _load_defaults {
    my ($file, $line) = @_;

    # Build up defaults, starting with the built-in defaults...
    my %defaults = @ARGUMENT_DEFAULTS;

    # Overwrite previous defaults with any readable global or local config file(s)...
    for my $config_file (grep {-r} "$ENV{HOME}/$RC_FILE_NAME", "./$RC_FILE_NAME") {
        %defaults = ( %defaults, _load_config($config_file) );
    }

    return \%defaults;
}

sub _load_config {
    my ($filename) = @_;

    # Grab contents of file...
    open my $fh, '<:utf8', $filename or return;
    local $/;
    my $config = readline($fh) // return;

    # Remove empty lines (including comment lines)...
    $config =~ s{ ^ \s* (?: \# [^\n]* )? (?:\n|\z) }{}gxms;

    # Extract keys and values of each option...
    my %opt = $config =~ m{ ^ \h* ([^:=]*?) \h* [:=] \h* ([^\n]*) (?:\n|\z) }gxms;

    # Convert a "*NAME" string to the corresponding named filehandle...
    if (exists $opt{to} && $opt{to} =~ m{ \A \* (.*) }x) {
        no strict 'refs';
        no warnings 'once';
        $opt{to} = \*{$1};
    }

    # Validate config...
    _validate_args(\%opt, "in $filename", "configuration option");

    return %opt;
}

# The whole point of the module...
sub show {
    # Find the various contexts of this call...
    my ($package, $file, $line, $hints_ref) = _get_context();
    my $call_context = wantarray();

    # Skip almost everything if "no Data::Show"...
    if (!$hints_ref->{'Data::Show/noshow'}) {

        # Identify current lexically-scoped config (should already have been loaded by import())...
        my $plugin_class = $hints_ref->{'Data::Show/with'} // $FINAL_CANDIDATE_PLUGIN;
        my %style        = %{ $STYLE[ $hints_ref->{'Data::Show/style'} ] };
        my $termwidth    = $hints_ref->{'Data::Show/termwidth'};

        # Warn about side-effects of multi-arg calls to show() in scalar context...
        if (defined $call_context && !$call_context && @_ > 1) {
            warn "Call to show() may not be not transparent at $file line $line\n";
        }

        # Serialize Contextual::Return objects (can break some dumpers in the Data::Dump family)...
        my @data = map { ref() =~ m{\AContextual::Return::Value}
                    ? do {my $v = $_->Contextual::Return::DUMP(); $v =~ s[\}\n][\},\n]gxms; eval $v; }
                    : $_
                    } @_;

        # Extract the originating source line(s)...
        my ($pre_source, $source, $post_source, $startline)
            = _get_source($file, $line, $hints_ref->{'Data::Show/as'});

        # What kind of data is it???
        my $is_single_hash = _data_is_single_hash($source, \@data, $hints_ref->{'Data::Show/as'});
        my $is_single_arg  = @data == 1;

        # Stringify the data...
        my $data = $plugin_class->stringify( $is_single_hash ? {@data}
                                           : $is_single_arg  ? $data[0]
                                           :                   \@data
                                           );

        # Some stringifiers add an (unwanted) empty first line, so remove it...
        $data =~ s{ \A \h* \n }{}xms;

        # Change delimters of any stringified arguments that were passed to the stringifier via refs...
        if    ($is_single_hash)  { $data =~ s{ \A (\s*) \{ (.*) \} (\s*) \z }{$1($2)$3}xms; }
        elsif (!$is_single_arg)  { $data =~ s{ \A (\s*) \[ (.*) \] (\s*) \z }{$1($2)$3}xms; }

        # Where are we printing to???
        my $fh = exists $hints_ref->{'Data::Show/to'} ? $OUTPUT_FH[$hints_ref->{'Data::Show/to'}]
                                                      : $DEFAULT_TARGET;

        # Disable styling if not outputting to a terminal or if styling is unavailable...
        if (!-t $fh || $style{mode} eq 'auto' && !$CAN_ANSICOLOR) {
            $style{mode} = 'off'
        }

        # Show the data with its context header (with style!)...
        no warnings 'utf8';
        print {$fh}
            $plugin_class->format(
                $file, $startline, $pre_source, $source, $post_source, $data, \%style, $termwidth,
            );
    }

    # Return the entire argument list if possible, otherwise simulate scalar context...
    return @_ if $call_context;
    return $_[0];
}

# Return the source code at a given file and line...
sub _get_source {
    my ($file, $line, $subname) = @_;

    # Optimize look-up via a cache...
    state %source_cache;

    # Load the entire source of requested file...
    if (!$source_cache{$file}) {
        # Load the source of an eval()...
        if ($file =~ m{\A \( eval \s+ \d+ \)}x) {
            $source_cache{$file} = (caller(2))[6];
        }

        # Otherwise, read in the source from the file...
        elsif (open my $filehandle, '<', $file) {
            $source_cache{$file} = do { local $/, readline($filehandle) };
        }

        else {
            # Otherwise, see if it's a #line trick in the main file...
            if (!defined $source_cache{$0} && open my $selfhandle, '<', $0) {
                $source_cache{$0} = do { local $/, readline($selfhandle) };
            }

            $source_cache{$file} = $source_cache{$0};
            $source_cache{$file} =~ s{ \A .*? ^ \# \h* line \h+ (\d+) \h+ \Q$file\E \h* \n }
                                     { "\n" x ($1-1) }xmse
                or $source_cache{$file} = q{};
            $source_cache{$file} =~ s{ \A .*? ^ \# \h* line \h+ (\d+) \h+ [^\n]* \n .* }{}xms;
        }
    }

    # This pattern detects when we have a complete show() call...
    state %SHOW_PATTERN_FOR;
    my $SHOW_PATTERN  = $SHOW_PATTERN_FOR{$subname}
                    //= qr{ (?  [^\n]*?  )
                            (?>
                                (?  \b(?:$subname)\b (?&PerlOWS) (?&PerlParenthesesList) )
                                (?  [^\n]* )
                            |
                                (?  \b(?:$subname)\b (?&PerlOWS) (?&PerlCommaList)       )
                                (?> (?       (?&PerlOWS)  (?: ; | \Z )  )
                                |   (?)  (?= (?&PerlOWS) \}  )
                                )
                            )
                            $PPR::GRAMMAR
                        }xms;

    # Locate the call in the source code (allowing for inaccuracies in caller() line results)...
    use re 'eval';
    our $prelim_lines; local $prelim_lines = $line-1;
    my $found = $source_cache{$file} =~ m{
        \A
        (?
            (?  (?: [^\n]* \n ){0,$prelim_lines}? (?&PerlOWS) )
            (?> $SHOW_PATTERN )
        )
        (??{ ($+{showlines} =~ tr/\n//) >= $prelim_lines ? q{} : '(?!)' })
    }xms;
    my %cap = %+;

    # Extract source code of call (the else should only very rarely need to be invoked)...
    if ($found) {
        return @cap{qw}, 1 + ($+{prelines} =~ tr/\n//);
    }
    else {
        return q{}, [0, split /\n/, $source_cache{$file}]->[$line], q{}, $line;
    }

}

# Attempt to detect a show() argument list that consists of a single hash...
sub _data_is_single_hash {
    my ($context, $data_ref, $subname) = @_;
    $context //= q{};

    # What does a single hash arg look like???
    state %SINGLE_HASH_FOR;
    my $SINGLE_HASH = $SINGLE_HASH_FOR{$subname}
                  //= qr{  \b(?:$subname) (?&PerlOWS)
                           (?:                (?&PerlVariableHash)
                             | \( (?&PerlOWS) (?&PerlVariableHash) (?&PerlOWS) \)
                           )
                           (?&PerlOWS) \z
                           $PPR::GRAMMAR
                        }x;

    # Must be only one argument (plus the invocant) and must look like a single hash...
    return @{$data_ref} % 2 == 0 && $context =~ $SINGLE_HASH;
}


# Base class for plugins...
package Data::Show::Plugin;

# When imported, make the imported plugin a base class of the importing class...
sub import {
    my ($package) = @_;
    no strict 'refs';
    @{caller().'::ISA'}  = $package;
}

# Visually distinguish the context string and data...
sub format {
    my ($class, $file, $line, $pre_source, $source, $post_source, $data, $style, $termwidth) = @_;
    $_ //= q{} for $pre_source, $source, $post_source;

    # Track previous file context between calls...
    state $prevfile = q{};
    my $is_new_context = $file ne $prevfile;
    $prevfile = $file;

    # Compute line numbering width...
    my $line_num_len = length( $line + ($pre_source . $source . $post_source) =~ tr/\n// );
    my $data_box_len = $termwidth - 4;
    my $code_box_len = $data_box_len - $line_num_len - 1;

    # ASCII-only decoration if explicitly requested, or if Term::ANSIcolor is unavailable...
    my $decorate_data    = $style->{mode} eq 'context'
                        || $style->{mode} eq 'off'     ? \&_monochrome : \&_polychrome;
    my $decorate_context = $style->{mode} eq 'off'     ? \&_monochrome : \&_polychrome;

    # Set up grid components (if requested)...
    my ($gridhead, $gridtail, $gridfsep, $gridcsep, $gridside, $gridline, $gridplus) = (q{}) x 7;
    my $padding = q{ } x $data_box_len;

    if ($style->{add_grid} ne 'off') {
        #                           $is_new_context    !$is_new_context
        # Top line of grid:         ┏━━━━━━━━━━━━━┓    ┏━━━┯━━━━━━━━━━┓
        $gridhead = $GRID{'┏'} . ($GRID{'━'} x ($termwidth-2)) . $GRID{'┓'} . "\n";
        substr($gridhead, $line_num_len+1, 1) = $GRID{'┯'} if !$is_new_context;

        # Post-filename separator:  ┠───┬─────────┨
        $gridfsep = $GRID{'┠'} . ($GRID{'─'} x ($termwidth-2)) . $GRID{'┨'} . "\n";
        substr($gridfsep, $line_num_len+1, 1) = $GRID{'┬'};

        # Post-code separator:      ┠───┴─────────┨    ┠───┴─────────┨
        $gridcsep = $GRID{'┠'} . ($GRID{'─'} x ($termwidth-2)) . $GRID{'┨'} . "\n";
        substr($gridcsep, $line_num_len+1, 1) = $GRID{'┴'};

        # Bottom line of grid:      ┗━━━━━━━━━━━━━┛    ┗━━━━━━━━━━━━━┛
        $gridtail = $GRID{'┗'} . ($GRID{'━'} x ($termwidth-2)) . $GRID{'┛'} . "\n";

        # Verticals of grid...
        $gridside = $GRID{'┃'};
        $gridplus = $GRID{'┃'} . q{ };
        $gridline = $GRID{'│'};

        # Decorate them all in the same style...
        for my $border ($gridhead, $gridtail, $gridfsep, $gridcsep, $gridside, $gridplus, $gridline) {
            $border = $decorate_context->($border, $style->{grid});
        }
    }

    # Style the source code...
    $source = join("\n", map {$decorate_context->($_, $style->{code})} split "\n", $pre_source)
            . join("\n", map {$decorate_context->($_, $style->{show})} split "\n", $source)
            . join("\n", map {$decorate_context->($_, $style->{code})} split "\n", $post_source);
    $source =~ s{ ^ }{  }gxms;

    # Install the line numbers and grid/format each source line...
    $source = join "\n",
              map {
                  $style->{add_grid} eq 'off'
                        ?                    m{ [^\n]* }xms
                        : ($_ . $padding) =~ m{ $COLOUR_CHAR {$code_box_len} }xms;
                  $gridside
                . $decorate_context->( sprintf('%*d', $line_num_len, $line++), $style->{line} )
                . $gridline . q{ } . $& . q{ } . $gridside
              }
              split "\n", $source;

    # Trim, grid, and format each data line...
    $data = join "\n",
            map {
                  $style->{add_grid} eq 'off' ? m{ [^\n]* }xms
                                              : ($_ . $padding) =~ m{ $COLOUR_CHAR {$data_box_len} }xms;
                  $gridplus . $decorate_data->( $&, $style->{data} ) . q{ } . $gridside
            }
            split "\n", $data;

    # Delineate source lines and data lines if no better styling has been specified...
    if (!$CAN_ANSICOLOR && $style->{add_grid} eq 'off') {
        $file   =~ s{ ^ }{### }gxms;
        $source =~ s{ ^ }{### }gxms;
        $data   =~ s{ ^ }{>>> }gxms;
    }

    return $gridhead
         . ($is_new_context
                ? do {
                       $style->{add_grid} eq 'off'
                           ? $file =~ m{ [^\n]* }xms
                           : ($file . $padding) =~ m{ $COLOUR_CHAR {$data_box_len} }xms;
                       $gridplus
                     . $decorate_context->( $&, $style->{file} )
                     . q{ } . $gridside . "\n"
                     . $gridfsep
                     }
                : q{}
           )
         . "$source\n"
         . $gridcsep
         . "$data\n"
         . $gridtail
         . "\n";
}


# Utility functions...

sub _monochrome { $_[0] }

sub _polychrome { &Term::ANSIColor::colored }

sub _antichrome { &Term::ANSIColor::colorstrip }

sub _max {
    my ($x, $y) = @_;
    return $x > $y ? $x : $y;
}

# Convert the data to a printable form (using Data::Dumper)...
sub stringify {
    my ($class, $data) = @_;

    # Choose conservative defaults (derive a subclass to change these)...
    use Data::Dumper 'Dumper';
    no warnings 'once';
    local $Data::Dumper::Deparse  = 0;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Deepcopy = 1;
    local $Data::Dumper::Terse    = 1;

    # Convert data to a string representation...
    my $stringification = Dumper($data);

    # Remove the annoying "$VAR1 = ", and realign subsequent indented lines...
#    $stringification =~ s{ ^ .{8} }{}gxms;

    # Remove the annoying trailing ';'...
    $stringification =~ s{ ; (\s*) \z }{$1}gxms;

    return $stringification;
}


# Template for constructing standard plugins...
my $NULL_FORMATTER; BEGIN { $NULL_FORMATTER = q{
    sub format {
       my ($class, $data) = @_;
       $data =~ s{\s*\z}{};
       return "$data\n\n";
    }
}}
sub _build_plugin {
    # (SHOUTY parameters get interpolated, mousy prarameters don't)...
    my ($NAME, $FALLBACK, $DUMP, $no_formatting) = @_;

    # Handle non-formatting plugins, and optimize argument look-up...
    my $FORMATTER = $no_formatting ? $NULL_FORMATTER : q{};
    my $DATA      = '$_[1]';

    return
        "Data::Show::Plugin::$NAME" => {
            requires => [$NAME],
            fallback => $FALLBACK,
            source   => qq{
                $FORMATTER
                sub stringify {
                    use $NAME q{$DUMP};
                    return (eval { $DUMP($DATA) }
                            // '<$NAME cannot show a ' . lc(ref($DATA)) . " reference>\n")
                         . "\n";
                }
            },
        };
}

# Initialize the data needed to instantiate the built-in plugins on-demand...
BEGIN {
    %STANDARD_PLUGIN = (

        #              DUMPER MODULE              FALLBACK        DUMP FUNC   VARIATIONS
        _build_plugin( 'Data::Dmp'             => 'Data::Pretty', 'dmp'                      ),
        _build_plugin( 'Data::Dump'            => 'Data::Dumper', 'pp',                      ),
        _build_plugin( 'Data::Dump::Color'     => 'Data::Dump',   'pp',       'preformatted' ),
        _build_plugin( 'Data::Dumper::Compact' => 'Data::Dump',   'ddc'                      ),
        _build_plugin( 'Data::Dumper::Concise' => 'Data::Dumper', 'Dumper'                   ),
        _build_plugin( 'Data::Dumper::Table'   => 'Dumpvalue',    'Tabulate'                 ),
        _build_plugin( 'Data::Pretty'          => 'Data::Dump',   'pp',                      ),
        _build_plugin( 'Data::TreeDumper'      => 'Dumpvalue',    'DumpTree'                 ),
        _build_plugin( 'YAML'                  => 'YAML::Tiny',   'Dump'                     ),
        _build_plugin( 'YAML::PP'              => 'YAML::Tiny',   'Dump'                     ),
        _build_plugin( 'YAML::Tiny'            => 'Dumpvalue',    'Dump'                     ),
        _build_plugin( 'YAML::Tiny::Color'     => 'YAML::Tiny',   'Dump',     'preformatted' ),

        "Data::Show::Plugin::Data::Dumper" => {
            requires => ['Data::Dumper'],
            fallback => 'DumpValue',
            source   => q{},  # ...because Data::Show::Plugin base class already uses Data::Dumper
        },

        'Data::Show::Plugin::Data::Printer' => {
            requires => ['Data::Printer'],
            fallback => 'Dumpvalue',
            source => qq{
                sub stringify {
                    use Data::Printer;
                    return np(\$_[1], colored=>$CAN_ANSICOLOR) . "\n";
                }
            },
        },

        'Data::Show::Plugin::Dumpvalue' => {
            requires => ['Dumpvalue'],
            source => q{
                sub stringify {
                    my ($class, $data) = @_;

                    # Create a singleton Dumpvalue object to do the stringification...
                    use Dumpvalue;
                    state $DUMPER = Dumpvalue->new(subdump=>1, globPrint=>1);

                    # Dumpvalue only dumps to STDOUT, so co-opt that filehandle to capture the output...
                    open +(local *STDOUT), '>', \\my $dump;

                    # Stringify the data to the captured STDOUT...
                    $DUMPER->dumpValue($data);

                    # Return the intercepted stringification...
                    return $dump;
                }
            },
        },

        # This plugin restores the previous (pre-version-0.003) output format for the module...
        'Data::Show::Plugin::Legacy' => {
            requires => ['Data::Dump', 'PPR', 'List::Util'],
            fallback => 'Data::Dump',
            source => q{
                sub format {
                    my ($class, $file, $line,
                        $pre_source, $source, $post_source,
                        $data, $style, $termwidth) = @_;

                    use List::Util 'max';

                    # Configuration for layout of representation...
                    state $DEFAULT_INDENT = 4;
                    state $MAX_DESC       = 30;
                    state $MAX_FILENAME   = 20;
                    state $TITLE_POS      = 3;

                    # Extract description of arglist from source...
                    $source =~ s{\\A show \b \\s*}{}x;
                    $source =~ s{\\s+}{ }gx;
                    $source =~ s{\\A \\( (.*) \\) \\Z}{$1}x;
                    if (length($source) > $MAX_DESC) {
                        $source = substr($source,0,$MAX_DESC-3) . q{...};
                    }

                    # Trim filename and format context info and description...
                    $file =~ s{.*[/\\\\]}{}xms;
                    if (length($file) > $MAX_FILENAME) {
                        $file =~ s/ (_[^\\W_]) [^\\W_]* /$1/gxms;
                    }
                    if (length($file) > $MAX_FILENAME) {
                        $file =~ s/\\A (.{1,8}) .*? (.{1,8}) \\Z/$1...$2/gxms;
                    }
                    my $context = "[ '$file', line $line ]";

                    # Insert title into header...
                    my $header = '=' x $termwidth;
                    substr($header, $TITLE_POS, length($source)+6) = "(  $source  )";
                    substr($header, -(length($context)+$TITLE_POS), length($context)) = $context;

                    # Indent data...
                    $data =~ s{^}{    }gxms;

                    # Assemble and send off...
                    return "$header\\n\\n$data\\n\\n";
                }

                # Original stringifier was Data::Dump...
                sub stringify {
                    use Data::Dump 'pp';
                    return pp($_[1]);
                }
            },
        },
    );
}


1; # Magic true value required at end of module
__END__