package CGI::Carp::DebugScreen::Dumper;
{
  use strict;
  use warnings;

  our $VERSION = '0.01';

  sub dump {
    my ($pkg, $thingy) = @_;

    return _dump($thingy);
  }

  sub _dump {
    my $thingy = shift;

    my $res = '';

    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;
      if ($thingy =~ /=HASH/) {
        my %hash = %{ $thingy };
        $blessed = \%hash;
      }
      elsif ($thingy =~ /=ARRAY/) {
        my @array = @{ $thingy };
        $blessed = \@array;
      }
      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/&/&amp;/g;
    $str =~ s/"/&quot;/g;
    $str =~ s/>/&gt;/g;
    $str =~ s/</&lt;/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;

  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 one package method.

=head2 dump()

takes a variable (supposedly, a reference) and returns an HTML table.

=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
