File Coverage

blib/lib/Data/Sah/Terse.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	18	20	90.0
condition	7	9	77.7
subroutine	7	7	100.0
pod	1	1	100.0
total	72	77	93.5

package Data::Sah::Terse;

our $DATE = '2015-01-03'; # DATE
our $VERSION = '0.02'; # VERSION

use 5.010001;
use strict;
use warnings;

use Data::Sah::Normalize qw(normalize_schema);

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(terse_schema);

# get type, this is a duplicate Data::Sah::Util::Type's get_type(). we can use
# it but that will currently pull Data-Sah as dependency.
sub _get_type {
    my $sch = shift;

    if (ref($sch) eq 'ARRAY') {
        $sch = $sch->[0];
    }

    if (defined($sch) && !ref($sch)) {
        $sch =~ s/\*\z//;
        return $sch;
    } else {
        return undef;
    }
}

sub _get_cset {
    my ($sch, $opts) = @_;

    if (ref($sch) eq 'ARRAY') {
        my $schn = $opts->{schema_is_normalized} ? $sch :
            normalize_schema($sch);
        return $schn->[1];
    } else {
        if ($sch =~ /\*/) {
            return {req=>1};
        } else {
            return {};
        }
    }
}

sub terse_schema {
    my ($sch, $opts) = @_;
    my $type = _get_type($sch);
    if ($type eq 'array') {
        my $cset = _get_cset($sch);
        return $type unless $cset->{of};
        return $type . "[" . terse_schema($cset->{of}) . "]";
    } elsif ($type eq 'any' || $type eq 'all') {
        my $cset = _get_cset($sch);
        return $type unless $cset->{of} && @{ $cset->{of} };
        my $join = $type eq 'any' ? '|' : ' & ';
        return join($join, map {terse_schema($_)} @{ $cset->{of} });
    } else {
        return $type;
    }
}

1;
# ABSTRACT: Make human-readable terse representation of Sah schema

__END__