view release on metacpan or  search on metacpan

lib/Acme/Data/Dumper/Extensions.pm  view on Meta::CPAN

use 5.006;    # our
use strict;
use warnings;

package Acme::Data::Dumper::Extensions;

our $VERSION = '0.001000';

# ABSTRACT: Experimental Enhancements to core Data::Dumper

# AUTHORITY

use Data::Dumper ();
use Exporter     ();

my $DD_Defaults;

BEGIN {
    no warnings 'once';
    $DD_Defaults = {
        Bless     => q[bless],
        Deepcopy  => 0,
        Deparse   => 0,
        Freezer   => q[],
        Indent    => 2,
        Maxdepth  => 0,
        Pad       => q[],
        Pair      => q[ => ],
        Purity    => 0,
        Quotekeys => 1,
        Sortkeys  => 0,
        Terse     => 0,
        Toaster   => q[],
        Useperl   => !( grep $_ eq 'Data::Dumper', @DynaLoader::dl_modules ),
        Useqq     => 0,
        Varname   => q[VAR],
    };

    $DD_Defaults->{Sparseseen} = 0    if eval { Data::Dumper->VERSION(2.136) };
    $DD_Defaults->{Maxrecurse} = 1000 if eval { Data::Dumper->VERSION(2.153) };
    $DD_Defaults->{Trailingcomma} = 0 if eval { Data::Dumper->VERSION(2.160) };
}

sub DD_Defaults {
    { %$DD_Defaults }
}

our $_new_with_defaults = sub {
    my ( $self, $user_defaults ) = @_;

    my $instance = $self->new( [] );

    # Initialise with system defaults
    my $instance_defaults = { %{$DD_Defaults} };

    # Validate and overwrite user defaults
    for my $key ( sort keys %{ $user_defaults || {} } ) {
        if ( not exists $DD_Defaults->{$key} ) {
            my $guesskey = ucfirst( lc($key) );
            my $dym =
              exists $DD_Defaults->{$guesskey}
              ? sprintf q[ (did you mean '%s'?)], $guesskey
              : q[];
            die sprintf "Unknown feature '%s'%s", $key, $dym;
        }
        $instance_defaults->{$key} = $user_defaults->{$key};
    }

    # Set all values
    for my $key ( sort keys %{$instance_defaults} ) {

        # Properties that aren't methods are bad?
        my $sub = $instance->can($key);
        die "No setter for feature '$key'" unless $sub;
        $instance->$sub( $instance_defaults->{$key} );
    }
    return $instance;
};

our $_DumpValues = sub {
    my ( $self, $values, $names ) = @_;