File Coverage

blib/lib/Data/Sah/From/JSONSchema.pm

Criterion	Covered	Total	%
statement	21	114	18.4
branch	10	66	15.1
condition	0	8	0.0
subroutine	6	14	42.8
pod	1	1	100.0
total	38	203	18.7

package Data::Sah::From::JSONSchema;

our $DATE = '2015-05-27'; # DATE
our $VERSION = '0.01'; # VERSION

use 5.010001;
use strict;
use warnings;

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

sub _clauses_common {
    my ($jsonsch, $sahsch) = @_;
    if (exists $jsonsch->{title}) {
        $sahsch->[1]{summary} = $jsonsch->{title};
    }
    if (exists $jsonsch->{description}) {
        $sahsch->[1]{description} = $jsonsch->{description};
    }
    if (exists $jsonsch->{default}) {
        $sahsch->[1]{default} = $jsonsch->{default};
    }
    # XXX enum/oneOf (which can be specified without 'type')
}

sub _convert_null {
    my $jsonsch = shift;
    my $sahsch = ["undef"];
    _clauses_common($jsonsch, $sahsch);
    $sahsch;
}

sub _clauses_num {
    my ($jsonsch, $sahsch) = @_;
    if (exists $jsonsch->{minimum}) {
        $sahsch->[1]{min} = $jsonsch->{minimum};
    }
    if (exists $jsonsch->{maximum}) {
        $sahsch->[1]{max} = $jsonsch->{maximum};
    }
    if (exists $jsonsch->{exclusiveMinimum}) {
        $sahsch->[1]{xmin} = $jsonsch->{exclusiveMinimum};
    }
    if (exists $jsonsch->{exclusiveMaximum}) {
        $sahsch->[1]{xmax} = $jsonsch->{exclusiveMaximum};
    }
    # XXX in sah, div_by is int only, not num
    if (exists $jsonsch->{multipleOf}) {
        $sahsch->[1]{div_by} = $jsonsch->{multipleOf};
    }
}

sub _convert_number {
    my $jsonsch = shift;
    my $sahsch = ["num", {req=>1}];
    _clauses_common($jsonsch, $sahsch);
    _clauses_num($jsonsch, $sahsch);
    $sahsch;
}

sub _convert_integer {
    my $jsonsch = shift;
    my $sahsch = ["int", {req=>1}];
    _clauses_common($jsonsch, $sahsch);
    _clauses_num($jsonsch, $sahsch);
    $sahsch;
}

sub _convert_boolean {
    my $jsonsch = shift;
    my $sahsch = ["bool", {req=>1}];
    _clauses_common($jsonsch, $sahsch);
    $sahsch;
}

sub _convert_string {
    my $jsonsch = shift;
    my $sahsch = ["str", {req=>1}];
    if (exists $jsonsch->{pattern}) {
        $sahsch->[1]{match} = $jsonsch->{pattern};
    }
    if (exists $jsonsch->{minLength}) {
        $sahsch->[1]{min_len} = $jsonsch->{minLength};
    }
    if (exists $jsonsch->{maxLength}) {
        $sahsch->[1]{max_len} = $jsonsch->{maxLength};
    }
    # XXX format, and builtin formats: date-time (RFC3339 section 5.6), email, hostname, ipv4, ipv6, uri
    $sahsch;
}

sub _convert_array {
    my $jsonsch = shift;
    my $sahsch = ["array", {req=>1}];
    if (exists($jsonsch->{minItems})) {
        $sahsch->[1]{min_len} = $jsonsch->{minItems};
    }
    if (exists($jsonsch->{maxItems})) {
        $sahsch->[1]{max_len} = $jsonsch->{maxItems};
    }
    if (exists($jsonsch->{items})) {
        if (ref($jsonsch->{items}) eq 'ARRAY') {
            $sahsch->[1]{elems} = [];
            my $i = 0;
            for my $el (@{ $jsonsch->{items} }) {
                $sahsch->[1]{elems}[$i] = _convert($el);
                $i++;
            }
            if (exists($jsonsch->{additionalItems}) && !$jsonsch->{additionalItems}) {
                $sahsch->[1]{max_len} = $i;
            }
        } else {
            $sahsch->[1]{of} = _convert($jsonsch->{items});
        }
    }
    # XXX uniqueItems
    $sahsch;
}

sub _convert_object {
    my $jsonsch = shift;
    my $sahsch = ["hash", {req=>1, 'keys.restrict'=>0}];
    if (exists($jsonsch->{minProperties})) {
        $sahsch->[1]{min_len} = $jsonsch->{minProperties};
    }
    if (exists($jsonsch->{maxProperties})) {
        $sahsch->[1]{max_len} = $jsonsch->{maxProperties};
    }
    if (exists $jsonsch->{properties}) {
        $sahsch->[1]{keys} = {};
        for my $k (keys %{ $jsonsch->{properties} }) {
            my $v = $jsonsch->{properties}{$k};
            $sahsch->[1]{keys}{$k} = _convert($v);
        }
    }
    if (exists($jsonsch->{additionalProperties}) && !$jsonsch->{additionalProperties}) {
        $sahsch->[1]{'keys.restrict'} = 1;
    }
    if (exists $jsonsch->{required}) {
        $sahsch->[1]{req_keys} = $jsonsch->{required};
    }
    if (exists $jsonsch->{dependencies}) {
        for my $k (keys %{ $jsonsch->{dependencies} }) {
            my $v = $jsonsch->{dependencies}{$k};
            if (ref($v) eq 'HASH') {
                # XXX schema dependencies
                die "Schema dependencies is not yet supported";
            } else {
                $sahsch->[1]{'req_dep_all&'} //= [];
                for my $d (@$v) {
                    push @{ $sahsch->[1]{'req_dep_all&'} }, [$d, [$k]];
                }
            }
        }
    }
    if (exists $jsonsch->{patternProperties}) {
        $sahsch->[1]{allowed_keys_re} = $jsonsch->{patternProperties};
    }
    $sahsch;
}

sub _convert {
    my $jsonsch = shift;

    ref($jsonsch) eq 'HASH' or die "JSON schema must be a hash";
    my $type = $jsonsch->{type} or die "JSON schema must have a type";
    # XXX type can be an array, e.g. [number, string] which means any one of those
    # XXX $ref instead of type
    # XXX format can be specified without type, implies string
    # XXX enum/oneOf (which can be specified without 'type')
    if ($type eq 'object') {
        _convert_object($jsonsch);
    } elsif ($type eq 'array') {
        _convert_array($jsonsch);
    } elsif ($type eq 'string') {
        _convert_string($jsonsch);
    } elsif ($type eq 'boolean') {
        _convert_boolean($jsonsch);
    } elsif ($type eq 'integer') {
        _convert_integer($jsonsch);
    } elsif ($type eq 'number') {
        _convert_number($jsonsch);
    } elsif ($type eq 'null') {
        _convert_null($jsonsch);
    } else {
        die "Unknown type '$type'";
    }
}

sub convert_json_schema_to_sah {
    _convert(@_);
}

1;
# ABSTRACT: Convert JSON schema to Sah schema

__END__