File Coverage

blib/lib/Hash/Tabular/Markdown.pm

Criterion	Covered	Total	%
statement	48	50	96.0
branch	7	10	70.0
condition	2	3	66.6
subroutine	9	9	100.0
pod	1	1	100.0
total	67	73	91.7

package Hash::Tabular::Markdown;
use 5.008001;
use strict;
use warnings;
use Data::Dumper;

our $VERSION = "0.01";

our $Delimit = "|";

our $DataDumperFunciton = sub {
    my ($value) = @_;
    return $value unless (ref($value));
    {
        local $Data::Dumper::Terse  = 1;
        local $Data::Dumper::Indent = 0;
        return Data::Dumper::Dumper($value);
    }
};

sub tabulate {
    my ($class, $hashref) = @_;

    return "require hash ref." unless ( ref($hashref) eq 'HASH' );

    my $md = _to_md($hashref);
    return $md;
}

sub _to_md {
    my ($content) = @_;

    my $dth = _hash_nest_depth( $content, 0 );
    my $md;
    my $delimit = $Delimit;
    $md .= $delimit . $delimit x $dth . "\n";
    $md .= $delimit . ":--$delimit" x $dth . "\n";
    my $nest = [$delimit];
    _to_table( $content, \$md, $nest );

    # $md =~ s/\n\n+/\n/g;
    return $md;
}

sub _hash_nest_depth {
    my ( $content, $dth ) = @_;

    my $max = $dth;
    $max++;
    $dth++;
    if ( ref($content) eq 'HASH' ) {
        foreach my $ky ( keys %$content ) {
            my $new = _hash_nest_depth( $content->{$ky}, $dth );
            $max = $max < $new ? $new : $max;
        }
    }
    return $max;
}

sub _dump {
    my ($content) = @_;
    return $DataDumperFunciton->($content);
}

sub _to_table {
    my ( $content, $md, $nest ) = @_;

    my $lf;
    if ( ref($content) eq 'HASH' && keys(%$content)) {
        foreach my $ky ( keys %$content ) {
            if ($lf) {
                $$md .= join( '', @$nest ) . _dump($ky);
                $lf = undef;
            }
            else {
                $$md .= $nest->[0] . _dump($ky);
            }
            push @$nest, $nest->[0];
            $lf = _to_table( $content->{$ky}, $md, $nest );
            pop @$nest;
        }
    }
    else {
        $$md .= "|" . _dump($content);
        $$md .= "\n";
        return 1;
    }
    return $lf;
}

1;
__END__