#!/usr/bin/perl -w
use strict;
use Data::Dumper::Lite;

my @array = qw(foo bar baz);
my %hash = (
  foo => \@array,
  bar => 'none',
  baz => 42,
);
my $dumper = Data::Dumper::Lite->new();
print $dumper->Dump(\%hash);

##</code><code>##

package Data::Dumper::Lite;

use strict;
use warnings;
use Scalar::Util qw(blessed reftype looks_like_number);
use B::Deparse;
use vars qw($VERSION);
$VERSION = "0.06";

*isa = \&UNIVERSAL::isa; # import UNIVERSAL::isa

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  my $self  = {
    DEPTH  => 0,      # data structure (DS) depth
    ORIG   => undef,  # original DS reference
    STRUCT => undef,  # DS being examined.  May switch to anon. array
    TYPE   => undef,  # type of DS being examined.  May switch to anon. array
    DUMP   => undef,  # data of the dump
  };
  $self->{REF} = {    # store our type handler subroutines
    SCALAR  => sub {
      $self->{DUMP} .= $self->_quote(${$self->{STRUCT}});
    },
    CODE    => sub {
      my $deparse = B::Deparse->new("-p", "-sC");
      my $code = $deparse->coderef2text($self->{STRUCT});
      $self->{DUMP} .= 'sub ' . $code;
    },
    GLOB    => sub {
      $self->{DUMP} .= '*' . *{$self->{STRUCT}}{PACKAGE} . '::' . *{$self->{STRUCT}}{NAME};
    },
    REF     => sub {
      $self->{DUMP} .= '\\';
      $self->Dump(${$self->{STRUCT}});
    },
    HASH    => sub {
      my %hash = %{$self->{STRUCT}};
      $self->_openstruct;
      foreach my $key (keys %hash) {
        $self->{DUMP} .= $self->_spacer . $key . ' => ';
        my $value = $hash{$key};
        if (reftype $value) {
          $self->Dump($value);
        } else {
          $self->{DUMP} .= $self->_quote($value) . ",\n";
        }
      }
      $self->_closestruct('HASH');
    },
    ARRAY   => sub {
      my @array = @{$self->{STRUCT}};
      $self->_openstruct;
      foreach my $value (@array) {
        $self->{DUMP} .= $self->_spacer;
        if (reftype $value) {
          $self->Dump($value);
        } else {
          $self->{DUMP} .= $self->_quote($value) . ",\n";
        }
      }
      $self->_closestruct('ARRAY');
    },
    LVALUE  => sub {
      $self->{DUMP} .= "#LVALUE\n" . $self->_quote(${$self->{STRUCT}});
    },
  };
  bless ($self, $class);
  return $self;
}

sub _spacer() {
  my $self = shift;
  return ($self->{DEPTH} == 1) ? '' : ' ' x $self->{DEPTH};
}

sub _quote {
  my $self = shift;
  my $value = shift;
  return (!defined $value) ? '' : (looks_like_number $value) ? $value : qq('$value');
}

sub _openstruct {
  my $self = shift;
  $self->{DUMP} .= ($self->{TYPE} eq 'HASH' ? '{' : '[') . "\n";
  ++$self->{DEPTH};
}

sub _closestruct {
  my $self = shift;
  my $type = shift; # I need a reminder (but not for long)
  --$self->{DEPTH};
  $self->{DUMP} .= $self->_spacer . ($type eq 'HASH' ? '}' : ']');
}

sub Dump {
  my $self = shift;
  $self->{STRUCT} = shift; # Get the reference to a data structure
  $self->{TYPE} = reftype $self->{STRUCT}; # is it a reference?
  my $blessed = blessed $self->{STRUCT};
  die "usage: Dump(REFERENCE)" if (!$self->{TYPE}); # if not, then die quickly
  if ($self->{DEPTH} == 0) {
    $self->{ORIG} = $self->{STRUCT}; # store original reference
    $self->{DUMP} = '$VAR = ';
  } else {
    if ($self->{STRUCT} == $self->{ORIG}) {  # see perlref
      $self->{DUMP} .= "\\\$VAR,\n";
      return;
    }
  }
  ++$self->{DEPTH};
  $self->{DUMP} .= "bless(" if ($blessed && !exists $self->{REF}{$blessed});
  if (exists $self->{REF}{$self->{TYPE}}) {
    &{$self->{REF}{$self->{TYPE}}};
  } else {
    $self->{DUMP} .= "Unknown {TYPE} $self->{TYPE}!\n";
  }
  if ($blessed && !exists $self->{REF}{$blessed}) {
    $self->{DUMP} .= ", " . $self->_quote($blessed) . ")";
  }
  
  if ($self->{DEPTH} == 1) {
    my $last = substr($self->{DUMP}, -2, 2);
    if ($last eq ",\n") {
      substr($self->{DUMP}, -2, 1) = ';';
    } elsif ($last ne ";\n") {
      $self->{DUMP} .= ";\n" ;
    }  
  }
  $self->{DUMP} .= ",\n" if ($self->{DEPTH} > 1);
  --$self->{DEPTH};
  return $self->{DUMP};
} # end of sub Dump

sub AUTOLOAD;

1;