File Coverage

blib/lib/Data/Dump/Sexp.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	20	20	100.0
condition	6	6	100.0
subroutine	12	12	100.0
pod	1	5	20.0
total	100	104	96.1

package Data::Dump::Sexp;

use 5.014000;
use strict;
use warnings;
use parent qw/Exporter/;

our @EXPORT = qw/dump_sexp/;
our @EXPORT_OK = @EXPORT;

our $VERSION = '0.002';

use Carp qw/croak/;
use Data::SExpression;
use Scalar::Util qw/reftype looks_like_number/;

sub dump_sexp;

sub dump_scalar {
	my ($expr) = @_;
	if (!defined $expr) {
		"()"
	} elsif (looks_like_number $expr) {
		"$expr"
	} else {
		my $escaped = $expr;
		$escaped =~ s,\\,\\\\,g;
		$escaped =~ s,",\\",g;
		qq,"$escaped",
	}
}

sub dump_cons {
	my ($expr) = @_;
	my $cdr = $expr->cdr;
	my $car = $expr->car;
	my $acc = '(' . dump_sexp($car);
	while (eval { $cdr->isa('Data::SExpression::Cons') }) {
		$car = $cdr->car;
		$cdr = $cdr->cdr;
		$acc .= ' ' . dump_sexp($car);
	}
	if (defined $cdr) {
		$acc .= ' . ' . dump_sexp($cdr);
	}
	$acc . ')'
}

sub dump_array {
	my ($expr) = @_;
	'(' . join (' ', map { dump_sexp($_) } @$expr). ')'
}

sub dump_hash {
	my ($expr) = @_;
	my @alist = map { Data::SExpression::cons $_, $expr->{$_} } sort keys %$expr;
	dump_array \@alist
}


sub dump_sexp {
	my ($expr) = @_;
	my $type = reftype $expr;
	if (eval { $expr->can('to_sexp') }) {
		dump_sexp $expr->to_sexp
	} elsif (eval { $expr->isa('Data::SExpression::Symbol') }) {
		"$expr"
	} elsif (eval { $expr->isa('Data::SExpression::Cons') }) {
		dump_cons $expr
	} elsif (!defined $type) {
		dump_scalar $expr
	} elsif ($type eq 'ARRAY') {
		dump_array $expr
	} elsif ($type eq 'HASH') {
		dump_hash $expr
	} elsif ($type eq 'SCALAR' || $type eq 'REF' || $type eq 'LVALUE') {
		dump_sexp $$expr
	} else {
		croak "Cannot dump value of type $type as sexp"
	}
}

1;
__END__