view release on metacpan or  search on metacpan

lib/Data/Printer/Profile/JSON.pm  view on Meta::CPAN

package Data::Printer::Profile::JSON;
use strict;
use warnings;

sub profile {
    return {
        show_tainted => 0,
        show_unicode => 0,
        show_lvalue  => 0,
        print_escapes => 0,
        scalar_quotes => q("),
        escape_chars => 'none',
        string_max => 0,
        unicode_charnames => 0,
        array_max => 0,
        index => 0,
        hash_max => 0,
        hash_separator => ': ',
        align_hash => 0,
        sort_keys => 0,
        quote_keys => 1,
        name => 'var',
        return_value => 'dump',
        output => 'stderr',
        indent => 2,
        show_readonly => 0,
        show_tied => 0,
        show_dualvar => 'off',
        show_weak => 0,
        show_refcount => 0,
        show_memsize => 0,
        separator => ',',
        end_separator => 0,
        caller_info => 0,
        colored => 0,
        class_method => undef,
        # Data::Printer doesn't provide a way to directly
        # decorate filters, so we do it ourselves:
        filters => [
            {
                '-class'  => \&_json_class_filter,
                'SCALAR'  => \&_json_scalar_filter,
                'LVALUE'  => \&_json_scalar_filter,
                'CODE'    => \&_json_code_filter,
                'FORMAT'  => \&_json_format_filter,
                'GLOB'    => \&_json_glob_filter,
                'REF'     => \&_json_ref_filter,,
                'Regexp'  => \&_json_regexp_filter,
                'VSTRING' => \&_json_vstring_filter,
            },
        ],
    };
}

sub _json_class_filter {
    my ($obj, $ddp) = @_;
    Data::Printer::Common::_warn($ddp, 'json cannot express blessed objects. Showing internals only');
    require Scalar::Util;
    my $reftype = Scalar::Util::reftype($obj);
    $reftype = 'Regexp' if $reftype eq 'REGEXP';
    $ddp->indent;
    my $string = $ddp->parse_as($reftype, $obj);
    $ddp->outdent;
    return $string;
}

sub _json_ref_filter {
    my ($ref, $ddp) = @_;
    my $reftype = ref $$ref;
    if ($reftype ne 'HASH' && $reftype ne 'ARRAY') {
        Data::Printer::Common::_warn($ddp, 'json cannot express references to scalars. Cast to non-reference');
    }
    require Scalar::Util;
    my $id = pack 'J', Scalar::Util::refaddr($$ref);