view release on metacpan or  search on metacpan

lib/Data/Dmp.pm  view on Meta::CPAN

our $OPT_PERL_VERSION = "5.010";
our $OPT_REMOVE_PRAGMAS = 0;
our $OPT_DEPARSE = 1;
our $OPT_STRINGIFY_NUMBERS = 0;

# BEGIN COPY PASTE FROM Data::Dump
my %esc = (
    "\a" => "\\a",
    "\b" => "\\b",
    "\t" => "\\t",
    "\n" => "\\n",
    "\f" => "\\f",
    "\r" => "\\r",
    "\e" => "\\e",
);

# put a string value in double quotes
sub _double_quote {
    local($_) = $_[0];

    # If there are many '"' we might want to use qq() instead
    s/([\\\"\@\$])/\\$1/g;
    return qq("$_") unless /[^\040-\176]/;  # fast exit

    s/([\a\b\t\n\f\r\e])/$esc{$1}/g;

    # no need for 3 digits in escape for these
    s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;

    s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
    s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;

    return qq("$_");
}
# END COPY PASTE FROM Data::Dump

# BEGIN COPY PASTE FROM String::PerlQuote
sub _single_quote {
    local($_) = $_[0];
    s/([\\'])/\\$1/g;
    return qq('$_');
}
# END COPY PASTE FROM String::PerlQuote

sub _dump_code {
    my $code = shift;

    state $deparse = do {
        require B::Deparse;
        B::Deparse->new("-l"); # -i option doesn't have any effect?
    };

    my $res = $deparse->coderef2text($code);

    my ($res_before_first_line, $res_after_first_line) =
        $res =~ /(.+?)^(#line .+)/ms;

    if ($OPT_REMOVE_PRAGMAS) {
        $res_before_first_line = "{";
    } elsif ($OPT_PERL_VERSION < 5.016) {
        # older perls' feature.pm doesn't yet support q{no feature ':all';}
        # so we replace it with q{no feature}.
        $res_before_first_line =~ s/no feature ':all';/no feature;/m;
    }
    $res_after_first_line =~ s/^#line .+//gm;

    $res = "sub" . $res_before_first_line . $res_after_first_line;
    $res =~ s/^\s+//gm;
    $res =~ s/\n+//g;
    $res =~ s/;\}\z/}/;
    $res;
}

sub _quote_key {
    $_[0] =~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ ||
        $_[0] =~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0] : _double_quote($_[0]);
}

sub _dump {
    my ($val, $subscript) = @_;

    my $ref = ref($val);
    if ($ref eq '') {
        if (!defined($val)) {
            return "undef";
        } elsif (looks_like_number($val) && !$OPT_STRINGIFY_NUMBERS &&
                     # perl does several normalizations to number literal, e.g.
                     # "+1" becomes 1, 0123 is octal literal, etc. make sure we
                     # only leave out quote when the number is not normalized
                     $val eq $val+0 &&
                     # perl also doesn't recognize Inf and NaN as numeric
                     # literals (ref: perldata) so these unquoted literals will
                     # choke under 'use strict "subs"
                     $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i
                 ) {
            return $val;
        } else {
            return _double_quote($val);
        }
    }
    my $refaddr = refaddr($val);
    $_subscripts{$refaddr} //= $subscript;
    if ($_seen_refaddrs{$refaddr}++) {
        my $target = "\$var" .
            ($_subscripts{$refaddr} ? "->$_subscripts{$refaddr}" : "");
        push @_fixups, "\$var->$subscript=$target;";
        return _single_quote($target);
    }

    my $class;

    if ($ref eq 'Regexp' || $ref eq 'REGEXP') {
        require Regexp::Stringify;
        return Regexp::Stringify::stringify_regexp(
            regexp=>$val, with_qr=>1, plver=>$OPT_PERL_VERSION);
    }

    if (blessed $val) {
        $class = $ref;
        $ref = reftype($val);
    }

    my $res;

lib/Data/Dmp.pm  view on Meta::CPAN

1;
# ABSTRACT: Dump Perl data structures as Perl code

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Dmp - Dump Perl data structures as Perl code

=head1 VERSION

This document describes version 0.242 of Data::Dmp (from Perl distribution Data-Dmp), released on 2022-08-28.

=head1 SYNOPSIS

 use Data::Dmp; # exports dd() and dmp()
 dd [1, 2, 3]; # prints "[1,2,3]"
 $var = dmp({a => 1}); # -> "{a=>1}"

Print truncated dump (capped at L</$Data::Dmp::OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS>
characters):

 use Data::Dmp qw(dd_ellipsis dmp_ellipsis);
 dd_ellipsis [1..100];

=head1 DESCRIPTION

Data::Dmp is a Perl dumper like L<Data::Dumper>. It's compact (only about 200
lines of code long), starts fast and does not use any non-core modules except
L<Regexp::Stringify> when dumping regexes. It produces compact single-line
output (similar to L<Data::Dumper::Concise>). It roughly has the same speed as
Data::Dumper (usually a bit faster for smaller structures) and faster than
L<Data::Dump>, but does not offer the various formatting options. It supports
dumping objects, regexes, circular structures, coderefs. Its code is first based
on L<Data::Dump>: I removed all the parts that I don't need, particularly the
pretty formatting stuffs) and added some features that I need like proper regex
dumping and coderef deparsing.

=head1 VARIABLES

=head2 $Data::Dmp::OPT_PERL_VERSION

String, default: 5.010.

Set target Perl version. If you set this to, say C<5.010>, then the dumped code
will keep compatibility with Perl 5.10.0. This is used in the following ways:

=over

=item * passed to L<Regexp::Stringify>

=item * when dumping code references

For example, in perls earlier than 5.016, feature.pm does not understand:

 no feature ':all';

so we replace it with:

 no feature;

=back

=head2 $Data::Dmp::OPT_REMOVE_PRAGMAS

Bool, default: 0.

If set to 1, then pragmas at the start of coderef dump will be removed. Coderef
dump is produced by L<B::Deparse> and is of the form like:

 sub { use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval'; $a <=> $b }

If you want to dump short coderefs, the pragmas might be distracting. You can
turn turn on this option which will make the above dump become:

 sub { $a <=> $b }

Note that without the pragmas, the dump might be incorrect.

=head2 $Data::Dmp::OPT_DEPARSE

Bool, default: 1.

Can be set to 0 to skip deparsing code. Coderefs will be dumped as
C<sub{"DUMMY"}> instead, like in Data::Dump.

=head2 $Data::Dmp::OPT_STRINGIFY_NUMBERS

Bool, default: 0.

If set to true, will dump numbers as quoted string, e.g. 123 as "123" instead of
123. This might be helpful if you want to compute the hash of or get a canonical
representation of data structure.

=head2 $Data::Dmp::OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS

Int, default: 70.

Used by L</dd_ellipsis> and L</dmp_ellipsis>.

=head1 BENCHMARKS

 [1..10]:
              Rate/s Precision/s  Data::Dump Data::Dumper Data::Dmp
 Data::Dump    24404          95          --       -61.6%    -75.6%
 Data::Dumper  63580         210 160.5+-1.3%           --    -36.4%
 Data::Dmp     99940         130 309.5+-1.7% 57.18+-0.55%        --
 
 [1..100]:
               Rate/s Precision/s  Data::Dump Data::Dumper Data::Dmp
 Data::Dump    2934.3         7.8          --       -75.3%    -76.2%
 Data::Dumper   11873          32 304.6+-1.5%           --     -3.7%
 Data::Dmp    12323.4           4   320+-1.1%   3.8+-0.28%        --
 
 Some mixed structure:
              Rate/s Precision/s   Data::Dump   Data::Dmp Data::Dumper