package CGI::Carp::DebugScreen::Dumper;
use strict;
use warnings;
our $VERSION = '0.15';
my $IgnoreOverload;
sub ignore_overload { shift; $IgnoreOverload = shift; }
sub dump {
my ($pkg, $thingy) = @_;
return _dump($thingy);
}
sub _dump {
my $thingy = shift;
my $res = '';
require overload if $IgnoreOverload;
if (!defined $thingy) {
$res .= 'undef';
}
elsif (ref $thingy eq 'HASH') {
if (%{ $thingy }) {
$res = qq{<table class="watch" border="1">\n};
foreach my $key (sort {$a cmp $b} keys %{ $thingy }) {
$res .= q{<tr><th>}._escape($key).q{</th><td>}._dump($thingy->{$key}).qq{</td></tr>\n};
}
$res .= qq{</table>\n};
}
else {
$res .= '*EMPTY_HASH*';
}
}
elsif (ref $thingy eq 'ARRAY') {
if (@{ $thingy }) {
$res .= join ', ', map { _dump($_) } @{ $thingy };
}
else {
$res .= '*EMPTY_ARRAY*';
}
}
elsif (ref $thingy eq 'SCALAR') {
$res .= _escape(${ $thingy });
}
elsif (ref $thingy eq 'CODE') {
$res .= '*CODE*';
}
elsif (ref $thingy eq 'GLOB') {
$res .= '*GLOB*';
}
elsif (my $name = ref $thingy) {
my $blessed;
my $strval = $IgnoreOverload ? overload::StrVal($thingy) : '';
if ($thingy =~ /=HASH/ or $strval =~ /=HASH/) {
my %hash = %{ $thingy };
$blessed = \%hash;
}
elsif ($thingy =~ /=ARRAY/ or $strval =~ /=ARRAY/) {
my @array = @{ $thingy };
$blessed = \@array;
}
elsif ($thingy =~ /=SCALAR/ or $strval =~ /=SCALAR/) {
$blessed = $$thingy;
}
elsif ($name eq 'REF') {
$blessed = $$thingy;
}
$res .= qq{<table class="watch" border="1">\n};
$res .= q{<tr><th>}._escape($name).q{ (blessed)</th><td>}.($blessed ? _dump($blessed) : _escape($thingy)).qq{</td></tr>\n};
$res .= qq{</table>\n};
}
else {
$res .= _escape($thingy);
}
return $res;
}
sub _escape {
my $str = shift;
return 'undef' unless defined $str;
return '*BINARY*' if $str =~ /[\x00-\x08\x0b\x0c\x0e-\x1f]/;
$str =~ s/&/&/g;
$str =~ s/"/"/g;
$str =~ s/>/>/g;
$str =~ s/</</g;
$str eq '' ? '*BLANK*' : $str;
}
1;
__END__
=head1 NAME
CGI::Carp::DebugScreen::Dumper - Dump a variable as an HTML table
=head1 SYNOPSIS
use CGI::Carp::DebugScreen::Dumper;
# if you want to poke into further
CGI::Carp::DebugScreen::Dumper->ignore_overload(1);
my $table = CGI::Carp::DebugScreen::Dumper->dump($thingy);
print "Content-type:text/html\n\n", $table;
=head1 DESCRIPTION
This module dumps the contents of a variable (supposedly, a reference) as an HTML table. If the variable has something unfit for an HTML output, it dumps alternative texts such as '*BINARY*', '*CODE*', or '*GLOB*'. It also escapes every key and value, so all you have to do is print some headers (likely to have been printed) and the dumped table. Dead easy.
=head1 METHOD
Currently this module has only two package methods.
=head2 dump()
takes a variable (supposedly, a reference) and returns an HTML table.
=head2 ignore_overload()
If set to true, dump() will ignore overloading (to stringify, maybe) and poke into the object further.
=head1 TODO
I'm afraid that this module should have another (and shorter) name and stand alone. The dumps() method should take array, hash, or multiple variables.
=head1 SEE ALSO
L<CGI::Carp::DebugScreen>
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Kenichi Ishigaki
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut