view release on metacpan or  search on metacpan

Peek.pm  view on Meta::CPAN

	"--no-check-syntax",
	"--no-standard-output",
	"--no-warning-output",
	);
    # RT#99514 - Perl::Tidy memoizes .perltidyrc incorrectly
    $has_perltidy > 20120714 and push @opts => "--no-memoize";

    Perl::Tidy::perltidy ('source' => \$s, 'destination' => \$t, 'argv' => \@opts);
    $s = $t;

    defined wantarray or warn $s;
    return $s;
    } # DTidy

### ############# DDump () ####################################################

sub _DDump_ref {
    my (undef, $down) = (@_, 0);

    my $ref = ref $_[0];
    if ($ref eq "SCALAR" || $ref eq "REF") {
	my %hash = DDump (${$_[0]}, $down);
	return { %hash };
	}
    if ($ref eq "ARRAY") {
	my @list;
	foreach my $list (@{$_[0]}) {
	    my %hash = DDump ($list, $down);
	    push @list, { %hash };
	    }
	return [ @list ];
	}
    if ($ref eq "HASH") {
	my %hash;
	foreach my $key (sort keys %{$_[0]}) {
	    $hash{DPeek ($key)} = { DDump ($_[0]->{$key}, $down) };
	    }
	return { %hash };
	}
    undef;
    } # _DDump_ref

sub _DDump {
    my (undef, $down, $dump, $fh) = (@_, "");

    if ($has_perlio and open $fh, ">", \$dump) {
	#print STDERR "Using DDump_IO\n";
	DDump_IO ($fh, $_[0], $down);
	close $fh;
	}
    else {
	#print STDERR "Using DDump_XS\n";
	$dump = DDump_XS ($_[0]);
	}

    return $dump;
    } # _DDump

sub DDump {
    my $down = @_ > 1 ? $_[1] : 0;
    my @dump = split m/[\r\n]+/, _DDump (@_ ? $_[0] : $_, wantarray || $down) or return;

    if (wantarray) {
	my %hash;
	($hash{'sv'} = $dump[0]) =~ s/^SV\s*=\s*//;
	m/^\s+(\w+)\s*=\s*(.*)/ and $hash{$1} = $2 for @dump;

	if (exists $hash{'FLAGS'}) {
	    $hash{'FLAGS'} =~ tr/()//d;
	    $hash{'FLAGS'} = { map {( $_ => 1 )} split m/,/ => $hash{'FLAGS'} };
	    }

	$down && ref $_[0] and
	    $hash{'RV'} = _DDump_ref ($_[0], $down - 1) || $_[0];
	return %hash;
	}

    my $dump = join "\n", @dump, "";

    defined wantarray and return $dump;

    warn $dump;
    } # DDump

sub DHexDump {
    use bytes;
    my $off = 0;
    my @out;
    my $var = @_ ? $_[0] : $_;
    defined $var or return;
    my $fmt = @_ > 1 && $_[1] < length ($var) ? "A$_[1]" : "A*";
    my $str = pack $fmt, $var;	# force stringification
    for (unpack "(A32)*", unpack "H*", $str) {
	my @b = unpack "(A2)*", $_;
	my $out = sprintf "%04x ", $off;
	$out .= " ".($b[$_]||"  ") for 0 ..  7;
	$out .= " ";
	$out .= " ".($b[$_]||"  ") for 8 .. 15;
	$out .= "  ";
	$out .= $pmap{$_} for map { chr hex $_ } @b;
	push @out, $out."\n";
	$off += 16;
	}

    wantarray and return @out;

    defined wantarray and return join "", @out;

    warn join "", @out;
    } # DHexDump

"Indent";

__END__

=head1 NAME

Data::Peek - A collection of low-level debug facilities

=head1 SYNOPSIS

 use Data::Peek;

 print DDumper \%hash;    # Same syntax as Data::Dumper
 DTidy { ref => $ref };

 print DPeek \$var;
 my ($pv, $iv, $nv, $rv, $magic) = DDual ($var [, 1]);
 print DPeek for DDual ($!, 1);
 print DDisplay ("ab\nc\x{20ac}\rdef\n");