File Coverage

blib/lib/Test/NiceDump.pm

Criterion	Covered	Total	%
statement	38	46	82.6
branch	2	4	50.0
condition			n/a
subroutine	12	14	85.7
pod	4	4	100.0
total	56	68	82.3

package Test::NiceDump;

use strict;
use warnings;

use Exporter "import";

use Test::Builder;
use Safe::Isa 1.000010;
use overload ();
use Data::Dump;
use Data::Dump::Filtered;

our @EXPORT_OK = ("nice_explain", "nice_dump");

# ABSTRACT: let's have a nice and human readable dump of our objects!


sub _dd_recurse {
    my ($object) = @_;
    # Data::Dump resets its filters when dumping the objects
    # we return; if we do it this way, we force it to keep
    # filtering, so (e.g.) datetime objects inside DBIC rows
    # will get dumped the way we want
    return Data::Dump::Filtered::dump_filtered(
        $object,
        \&_dd_filter,
    );
}

# functions to modify this hash are at the bottom of this file
my %filters = (
    'Test::NiceDump::010_DateTime' => sub {
        $_[0]->$_isa('DateTime')
            ? $_[0]->format_cldr("yyyy-MM-dd'T'HH:mm:ssZZZZZ")
            : ();
    },
    'Test::NiceDump::011_Test_Deep_Methods' => sub {
        $_[0]->$_isa('Test::Deep::Methods')
            ? $_[0]->{methods}
            : ();
    },
    'Test::NiceDump::012_Test_Deep' => sub {
        (ref($_[0]) || '') =~ /^Test::Deep::/
            ? $_[0]->{val}
            : ();
    },
    'Test::NiceDump::013_DBIC_Schema' => sub {
        $_[0]->$_isa('DBIx::Class::Schema')
            ? 'DBIx::Class::Schema object'
            : ();
    },
    'Test::NiceDump::020_overload' => sub { overload::Method($_[0],q{""}) ? "$_[0]" : () },
    'Test::NiceDump::021_as_string' => sub { shift->$_call_if_can('as_string') },
    'Test::NiceDump::022_to_string' => sub { shift->$_call_if_can('to_string') },
    'Test::NiceDump::023_toString' => sub { shift->$_call_if_can('toString') },
    'Test::NiceDump::024_TO_JSON' => sub { shift->$_call_if_can('TO_JSON') },
    'Test::NiceDump::030_get_inflated_columns' => sub {
        my %c = shift->$_call_if_can('get_inflated_columns');
        %c ? \%c : ();
    },
);

sub _dd_filter {
    my ($ctx, $object) = @_;

    for my $filter_name (sort keys %filters) {
        my $filter_code = $filters{$filter_name};
        my @filtered_object = $filter_code->($object);
        if (@filtered_object) {
            return {
                dump => _dd_recurse($filtered_object[0]),
                comment => $ctx->class,
            };
        }
    }

    return;
}


sub nice_dump {
    my ($data) = @_;
    return Data::Dump::Filtered::dump_filtered( $data, \&_dd_filter );
}


sub nice_explain {
    my ($data, $comparator) = @_;
    my $tb = Test::Builder->new; # singleton
    $tb->diag("Got:" . nice_dump( $data ));
    $tb->diag("Expected: " . nice_dump( $comparator )) if defined $comparator;
    return 0; # like diag / explain do
}


sub add_filter {
    my ($filter_name, $filter_code) = @_;
    $filters{$filter_name} = $filter_code;
    return;
}

sub remove_filter {
    my ($filter_name) = @_;
    delete $filters{$filter_name};
    return;
}

1;

__END__