File Coverage

blib/lib/TypeLibrary/FromXSD.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package TypeLibrary::FromXSD;

# ABSTRACT: create a Type::Tiny library of simpleTypes in .xsd files.

use strict;
use warnings;

use Moo;

use File::Basename;
use XML::LibXML;

use TypeLibrary::FromXSD::Element;

our $VERSION = 0.03;

has types       => (is => 'rwp');
has xsd         => (is => 'ro', required => 1);
has output      => (is => 'ro');
has namespace   => (is => 'ro');
has version_add => (is => 'ro', default => sub{ '0.01' } );

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

    my $tree      = XML::LibXML->new->parse_file( $self->xsd )->getDocumentElement;
    my @typeNodes = $tree->getElementsByTagName('xs:simpleType');

    my $out_fh    = *STDOUT;
    my $namespace = $self->namespace || 'Library';

    if ( $self->output ) {
        open $out_fh, '>', $self->output;
        $namespace = $self->namespace || basename $self->output;
        $namespace =~ s/\.pm\z//;
    }

    my @types;
    my %types_used;
    for my $node ( @typeNodes ) {
        my $element = TypeLibrary::FromXSD::Element->new(
            $node,
            validate => {
                date     => 'validate_date',
                dateTime => 'validate_datetime',
            },
        );

        push @types, $element;
        $types_used{ $element->orig_base }++;
    }

    my $declare = join ' ', map{ $_->name }@types;
    print $out_fh $self->_module_header( $namespace, $declare );

    if ( $types_used{date} || $types_used{dateTime} ) {
        print $out_fh "\nuse DateTime;\n\n";
    }

    for my $type ( @types ) {
        print $out_fh $type->type,"\n\n";
    }

    if ( $types_used{date} ) {
        print $out_fh $self->_validate_date_sub;
    }

    if ( $types_used{dateTime} ) {
        print $out_fh $self->_validate_datetime_sub;
    }

    print $out_fh "1;\n";
}

sub _module_header {
    my ($self, $ns, $declare) = @_;

    my $version = $self->version_add;
    if ( $self->output and -f $self->output ) {
        my $content = do{ local (@ARGV,$/) = $self->output; <> };
        ($version)  = $content =~ m{\$VERSION\s*=\s*(.*?);};
        $version   += $self->version_add;
    }

    qq*package $ns;

use strict;
use warnings;

use Type::Library
   -base,
   -declare => qw( $declare );
use Type::Utils -all;
use Types::Standard -types;

our \$VERSION = $version;
*;
}

sub _validate_date_sub {
    q*sub validate_date {
    my ($date) = @_;

    $date =~ s/\A-//;
    my ($year,$month,$day,$hour,$min) = split /[-Z+:]/, $date;

    eval {
        DateTime->new(
            year  => $year,
            month => $month,
            day   => $day,
        );
    } or return 0;

    return 0 if ( $hour and ( $hour < 0 or $hour > 12 ) );
    return 0 if ( $min  and ( $min < 0 or $min > 59 ) );

    return 1;
}

*;
}

sub _validate_datetime_sub {
    q*sub validate_datetime {
    my ($date) = @_;

    $date =~ s/\A-//;
    my ($year,$month,$day,$hour,$min) = split /[-Z+:]/, $date;

    eval {
        DateTime->new(
            year  => $year,
            month => $month,
            day   => $day,
        );
    } or return 0;

    return 0 if ( $hour and ( $hour < 0 or $hour > 12 ) );
    return 0 if ( $min  and ( $min < 0 or $min > 59 ) );

    return 1;
}

*;
}

1;

__END__