File Coverage

blib/lib/TypeLibrary/FromXSD/Element.pm

Criterion	Covered	Total	%
statement	3	64	4.6
branch	0	34	0.0
condition	0	14	0.0
subroutine	1	5	20.0
pod	1	2	50.0
total	5	119	4.2

package TypeLibrary::FromXSD::Element;

# ABSTRACT: Create a single type decleration from a simpleType xsd element

use Moo;

our $VERSION = 0.03;

has name         => (is => 'ro', required => 1);
has base         => (is => 'ro', required => 1);
has orig_base    => (is => 'ro' );
has enum         => (is => 'ro', predicate => 1);
has restrictions => (is => 'ro', predicate => 1);

sub type {
    my ($self) = @_;

    return sprintf "declare %s =>\n    as %s%s;",
        $self->name,
        $self->_basetype,
        $self->_where,
}

sub _basetype {
    my ($self) = @_;

    return $self->base if !$self->has_enum;
    return sprintf "enum [%s]", join ",", map{ $_ =~ s/'/\'/g; "'$_'" } @{ $self->enum };
}

sub _where {
    my ($self) = @_;

    return '' if !$self->restrictions;
    return sprintf ",\n    where {\n        %s\n    }",
               join " && \n        ", map{ "($_)" }@{ $self->restrictions };
}

sub BUILDARGS {
    my ($class, @args) = @_;

    return {@args} if @args > 1 && @args % 2 == 0;

    my $node = shift @args;

    my $extra_validations;
    if ( @args > 1 ) {
        my %args = @args;
        $extra_validations = delete $args{validate};
    }

    my %real_args;
    if ( $node ) {

        return {} if !ref $node || !$node->isa('XML::LibXML::Element');

        $real_args{name} = $node->findvalue('@name');

        my ($restrictions_node) = $node->findnodes('xs:restriction');

        my $base = $restrictions_node->findvalue('@base');

        my %base_map = (
            'xs:string'   => 'Str',
            'xs:decimal'  => 'Num',
            'xs:date'     => 'Str',
            'xs:dateTime' => 'Str',
        );

        $real_args{base} = $base_map{$base} || 'Str';

        my @restrictions = $restrictions_node->childNodes;
        for my $restriction ( @restrictions ) {

            my $node_name = $restriction->nodeName;

            if ( $node_name eq 'xs:enumeration' ) {
                push @{ $real_args{enum} }, $restriction->findvalue('@value');
            }
            elsif ( $node_name eq 'xs:minLength' ) {
                push @{ $real_args{restrictions} }, 'length($_) >= ' . $restriction->findvalue('@value');
            }
            elsif ( $node_name eq 'xs:maxLength' ) {
                push @{ $real_args{restrictions} }, 'length($_) <= ' . $restriction->findvalue('@value');
            }
            elsif ( $node_name eq 'xs:pattern' ) {
                my $pattern = $restriction->findvalue('@value');
                $pattern    =~ s/!/\!/g;
                push @{ $real_args{restrictions} }, sprintf '$_ =~ m!%s!', $pattern;
            }
            elsif ( $node_name eq 'xs:minInclusive' ) {
                push @{ $real_args{restrictions} }, '$_ >= ' . $restriction->findvalue('@value');
            }
            elsif ( $node_name eq 'xs:maxInclusive' ) {
                push @{ $real_args{restrictions} }, '$_ <= ' . $restriction->findvalue('@value');
            }
            elsif ( $node_name eq 'xs:fractionDigits' ) {
                push @{ $real_args{restrictions} }, 'length( (split /\./, $_)[1] ) == ' . $restriction->findvalue('@value');
            }
            elsif ( $node_name eq 'xs:totalDigits' ) {
                push @{ $real_args{restrictions} }, 'tr/0123456789// == ' . $restriction->findvalue('@value');
            }
        }

        $base =~ s/^xs://;
        if ( $base eq 'date' ) {
            push @{ $real_args{restrictions} }, '$_ =~ m{\A-?[0-9]{4,}-[0-9]{2}-[0-9]{2}(?:Z|[-+]?[0-2][0-9]:[0-5][0-9])?\z}';
        }
        elsif ( $base eq 'dateTime' ) {
            push @{ $real_args{restrictions} },
                '$_ =~ m{\A-?[0-9]{4,}-[0-9]{2}-[0-9]{2}T[0-2][0-9]:[0-5][0-9]:[0-5][0-9](?:Z|[-+]?[0-2][0-9]:[0-5][0-9])?\z}';
        }

        if ( $base =~ m{\Adate(Time)?\z} and $extra_validations and $extra_validations->{$base} ) {
            push @{ $real_args{restrictions} }, $extra_validations->{$base} . '($_)';
        }

        $real_args{orig_base} = $base;
    }

    return \%real_args;
}

1;

__END__