# -*- mode: Perl; -*-

package NewsClipper::Handler::Output::dumpdata;

use vars qw( @ISA $VERSION %handlerInfo );

$handlerInfo{'Author_Name'}              = 'David Coppit';
$handlerInfo{'Author_Email'}             = 'david@coppit.org';
$handlerInfo{'Maintainer_Name'}          = 'David Coppit';
$handlerInfo{'Maintainer_Email'}         = 'david@coppit.org';
$handlerInfo{'Description'}              =<<'EOF';
Dumps the input data for debugging purposes.
EOF
$handlerInfo{'Category'}                 = 'News Clipper';
$handlerInfo{'URL'}                      = '';
$handlerInfo{'License'}                  = 'GPL';
$handlerInfo{'For_News_Clipper_Version'} = '1.18';
$handlerInfo{'Language'}                 = 'Any';
$handlerInfo{'Notes'}                    =<<'EOF';
EOF
$handlerInfo{'Syntax'}                   =<<'EOF';
<output name=dumpdata style=X>
   X=text:	Outputs as indented text (default)
   X=html:	Outputs as an HTML table

   In HTML output, undef is in italics, variable names are underlined,
   basic data types (scalar, nonref scalar, array, hash) are in bold and
   custom data types and in bold and underlined.
EOF

use strict;
use NewsClipper::Handler;
use NewsClipper::Types qw( GetTypeSignature ConvertTypeToEnglish);
@ISA = qw(NewsClipper::Handler);

# - The first number should be incremented when a change is made to the
#   handler that will break people's input files.
# - The second number should be incremented when a change is made that won't
#   break people's input files, but changes the functionality.
# - The third number should be incremented when only a bugfix is applied.

$VERSION = do {my @r=('0.2.0'=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};

# ------------------------------------------------------------------------------

sub OutputType
{
  return '$ | @ | %';
}

# ------------------------------------------------------------------------------

sub Output
{
  my $self = shift;
  my $attributes = shift;
  my $grabbedData = shift;

  my @data;

  my $style = 'text';
  $style = $attributes->{style} if defined $attributes->{style};

  print "<p>\n  Type signature is: ", GetTypeSignature($grabbedData),
    " (\"" , ConvertTypeToEnglish(GetTypeSignature($grabbedData)) , "\")",
    "\n</p>\n";

  print "<p>\n";
  ($style eq 'html') && print "<table border=1>\n";
  _RecurseData($grabbedData,1,$style);
  ($style eq 'html') && print "</table>\n";
  print "</p>\n";
}

# ------------------------------------------------------------------------------

sub _RecurseData($$)
{
  my $data = shift;
  my $depth = shift;
  my $style = shift;

  my($SCALAR,$NONREFSCALAR,$ARRAY,$HASH,$UNDEF,) = 
     ('SCALAR','NONREF SCALAR','ARRAY','HASH','UNDEF');
  my $ARROW = '=>';

  if ($style eq 'html') {
    $SCALAR = "<b>$SCALAR</b>";
    $NONREFSCALAR = "<b>$NONREFSCALAR</b>";
    $ARRAY = "<b>$ARRAY</b>";
    $HASH = "<b>$HASH</b>";
    $UNDEF = "<i>$UNDEF</i>";
    $ARROW = '=&gt;';
  }
  
  # We're not using TypesMatch here because the data structure may contain
  # illegal SCALARs that aren't references to SCALARs.
  if (!defined $data)
  {
    ($style eq 'html') && print "  "x$depth, "<tr><td>\n";
    print "  "x$depth, "$UNDEF\n";
    ($style eq 'html') && print "  "x$depth, "</td></tr>\n";
  }
  elsif (!ref $data)
  {
    ($style eq 'html') && print "  "x$depth, "<tr><td>\n";
    print "  "x$depth, "$NONREFSCALAR: $data\n";
    ($style eq 'html') && print "  "x$depth, "</td></tr>\n";
  }
  # Some kind of blessed object
  elsif (UNIVERSAL::isa($data,'SCALAR'))
  {
    ($style eq 'html') && print "  "x$depth, "<tr><td>\n";
    if (ref($data) eq 'SCALAR') {
      print "  "x$depth, $SCALAR;
    } else {
      print "  "x$depth, (($style eq 'html') ? '<b><u>'.ref($data).'</u></u>' : ref $data), " ($SCALAR)";
    }
    if (defined $$data)
    {
      print ": $$data\n";
    }
    else
    {
      print ": $UNDEF\n";
    }
    ($style eq 'html') && print "  "x$depth, "</td></tr>\n";
  }
  elsif (UNIVERSAL::isa($data,'ARRAY'))
  {
    ($style eq 'html') && print "  "x$depth, "<tr><td>\n";
    if (ref($data) eq 'ARRAY') {
      print "  "x$depth, $ARRAY;
    } else {
      print "  "x$depth, (($style eq 'html') ? '<b><u>'.ref($data).'</u></u>' : ref $data), " ($ARRAY)";
    }
#    print "  "x$depth, ref $data;
#    print " ($ARRAY)" if ref($data) ne 'ARRAY';
    print ":\n";
    foreach my $temp (@$data)
    {
      ($style eq 'html') && print "  "x$depth, "<table border=1>\n";
      _RecurseData($temp,$depth+1,$style);
      ($style eq 'html') && print "  "x$depth, "</table>\n";
    }
  }
  elsif (UNIVERSAL::isa($data,'HASH'))
  {
    ($style eq 'html') && print "  "x$depth, "<tr><td>\n";
    if (ref($data) eq 'HASH') {
      print "  "x$depth, $HASH;
    } else {
      print "  "x$depth, (($style eq 'html') ? '<b><u>'.ref($data).'</u></u>' : ref $data), " ($HASH)";
    }
#    print "  "x$depth, ref $data;
 #   print " ($HASH)" if ref($data) ne 'HASH';

    print ":\n";
    foreach my $temp (keys %$data)
    {
      ($style eq 'html') && print "  "x$depth, "<table border=1><tr><td>\n";
      print "  "x($depth+1), (($style eq 'html') ? "<u>$temp</u>" : $temp), "$ARROW\n";
      ($style eq 'html') && print "  "x($depth+1), "<table border=1>\n";
      _RecurseData($$data{$temp},$depth+2,$style);
      ($style eq 'html') && print "  "x($depth+1), "</table>\n";
      ($style eq 'html') && print "  "x$depth, "</td></tr></table>\n";
    }
    ($style eq 'html') && print "  "x$depth, "</td></tr>\n";
  }
  else
  {
    ($style eq 'html') && print "  "x$depth, "<tr><td>\n";
    print "  "x$depth, ref $data, ": UNKNOWN TYPE\n";
    ($style eq 'html') && print "  "x$depth, "</td></tr>\n";
  }
}

1;