The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Ruby::Inspect;

use strict;
use warnings;

our $VERSION = '0.01';

use Scalar::Util qw(blessed reftype refaddr looks_like_number);

our $in_inspect = 0;

sub inspect
{
	return 'undef' unless defined $_[0];

	local $in_inspect = $in_inspect + 1;

	my $obj = $_[0];

	unless($_[1]){
		push @_, { };
	}

	my $seen = $_[1];
	
	if(ref $obj and $seen->{ refaddr $obj }++){
		my $reftype = reftype($obj);
		if($reftype eq 'HASH'){
			return '{...}';
		}
		elsif($reftype eq 'ARRAY'){
			return '[...]';
		}
		else{
			return '(...)';
		}
	}

	if($in_inspect <= 1 and blessed($obj)){
		if(my $inspect = $obj->can('inspect')){
			return scalar( $obj->$inspect() );
		}
	}

	return &basic_inspect;
}

my %esc = (
	"\a" => '\a',
	"\b" => '\b',
	"\n" => '\n',
	"\r" => '\r',
	"\t" => '\t',
	"\f" => '\f',
	"\e" => '\e',
	"\0" => '\0',
	"\\" => '\\\\',
	"\"" => '\"',
);
my $esc = join('', values %esc);
sub basic_inspect
{
	my $obj = $_[0];

	# reference
	if(ref $obj){
		my $reftype = reftype($obj);

		my $result = '';

		if(my $class = blessed($obj)){
			$result .= "${class}=";

			if($class eq 'Regexp'){
				$result .= $obj;
				return $result;
			}
		}

		no strict 'refs';
		my $inspector = \&{$reftype};

		if(defined &$inspector){
			$result .= &$inspector;
		}
		else{
			$result .= sprintf('%s(0x%x)', $reftype, refaddr($obj));
		}
		return $result;
	}
	# primitive string or numeric or type glob
	else{
		my $type = reftype(\$obj);

		if($type eq 'GLOB'){
			return sprintf '*%s%s', *{$obj}{PACKAGE} eq 'main' ? '' : *{$obj}{PACKAGE}.'::', *{$obj}{NAME};
		}
		elsif(looks_like_number($obj)){
			return "$obj";
		}
		else{
			$obj =~ s/([$esc])/$esc{$1}/go;
			return qq("$obj");
		}
	}
}

sub HASH{
	my $hr = $_[0];

	my $result = '';

	while(my($key, $val) = each %$hr){

		$result .= inspect($key, $_[1]);
		$result .= ' => ';
		$result .= inspect($val, $_[1]);
		$result .= ",";
	}

	chop $result;

	return "{$result}";
}

sub ARRAY{
	my $ar = $_[0];

	my $result = '';

	foreach (@$ar){
		$result .= inspect($_, $_[1]);
		$result .= ",";
	}
	chop $result;

	return "[$result]";
}
sub SCALAR{
	my $sr = $_[0];

	return '\\' . inspect($$sr, $_[1]);

}
sub REF{
	my $rr = $_[0];

	return '\\' . inspect($$rr, $_[1]);
}
sub GLOB{
	my $gr = $_[0];

	return '\\' . inspect(*$gr, $_[1]);
}

sub CODE{
	my $cr = $_[0];

	require B::Deparse;
	my $deparser = B::Deparse->new(qw(-sC -si0));

	my $result = $deparser->coderef2text($cr);

	if($result eq ';'){
		$result = '{ (XSUB) }';
	}
	else{
		$result =~ tr/\n/ /;
	}

	return "sub " . $result;
}


1;