File Coverage

blib/lib/SOAP/WSDL/XSD/SimpleType.pm

Criterion	Covered	Total	%
statement	53	63	84.1
branch	15	26	57.6
condition	8	15	53.3
subroutine	9	9	100.0
pod	0	4	0.0
total	85	117	72.6

package SOAP::WSDL::XSD::SimpleType;
use strict;
use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);

our $VERSION = 3.003;

my %length_of           :ATTR(:name         :default<[]>);
my %minLength_of        :ATTR(:name      :default<[]>);
my %maxLength_of        :ATTR(:name      :default<[]>);
my %pattern_of          :ATTR(:name        :default<[]>);
my %enumeration_of      :ATTR(:name    :default<[]>);
my %whiteSpace_of       :ATTR(:name     :default<[]>);
my %totalDigits_of      :ATTR(:name    :default<[]>);
my %fractionDigits_of   :ATTR(:name    :default<[]>);
my %minExclusive        :ATTR(:name   :default<[]>);
my %minInclusive        :ATTR(:name   :default<[]>);
my %maxExclusive        :ATTR(:name   :default<[]>);
my %maxInclusive        :ATTR(:name   :default<[]>);

my %fixed               :ATTR(:name          :default<[]>);

my %annotation_of       :ATTR(:name     :default<()>);
my %base_of             :ATTR(:name           :default<()>);
my %itemType_of         :ATTR(:name       :default<()>);


# TODO rename flavor to variety to be consistent with the XML Schema
# specs - though flavor is the cooler name..
# set to restriction|list|union|enumeration
my %flavor_of       :ATTR(:name         :default<()>);

# for simpleType containing atomic simple types
my %type_of         :ATTR(:name           :default<()>);

sub get_simpleType; *get_simpleType = \&get_type;
sub set_simpleType; *set_simpleType = \&set_type;

sub get_variety; *get_variety = \&get_flavor;

sub set_restriction {
    my $self = shift;
    my @attributes = @_;
    $self->set_flavor( 'restriction' );

    for (@attributes) {
        next if (not $_->{ LocalName } eq 'base');
        $self->set_base( $_->{ Value } );
    }
}

sub set_list {
    my $self = shift;
    my @attributes = @_;
    $self->set_flavor( 'list' );
    for (@attributes) {
        next if (not $_->{ LocalName } eq 'itemType');
        $self->set_itemType( $_->{ Value } );
    }
}

sub set_union {
    my $self = shift;
    my @attributes = @_;
    $self->set_flavor( 'union' );
    for (@attributes) {
        next if (not $_->{ LocalName } eq 'memberTypes');
        $self->set_base( [ split /\s/, $_->{ Value } ] );
    }
}

sub serialize {
    my $self = shift;
    my $name = shift;
    my $value = shift;
    my $opt = shift;
    my $ident = ident $self;

    $opt->{ attributes } ||= [];
    $opt->{ indent } ||= q{};

    return $self->_serialize_single($name, $value , $opt)
      if ( $flavor_of{ $ident } eq 'restriction'
        or $flavor_of{ $ident } eq 'union'
        or $flavor_of{ $ident } eq 'enumeration');

    if ($flavor_of{ $ident } eq 'list' )
    {
        $value ||= [];
        $value = [ $value ] if ( ref( $value) ne 'ARRAY' );
        return $self->_serialize_single($name, join( q{ }, @{ $value } ), $opt);
    }
}

sub _serialize_single {
    my ($self, $name, $value, $opt) = @_;
    my $xml = '';
    $xml .= $opt->{ indent } if ($opt->{ readable });       # add indentation
    $xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
    if ( $opt->{ autotype }) {
        # reverse namespace by prefix hash
        my $ns = $self->get_targetNamespace();

        # build a list of hash keys (eg '#default', 'tns') whose values match our namespace (eg 'urn:myNamespace')
        (my @possible_namespace_names) = grep { $opt->{ namespace }->{$_} eq $ns } keys %{ $opt->{ namespace } };

        # put any '#default' option last
        @possible_namespace_names = sort { $a eq '#default' ? 1 : $b eq '#default' ? -1 : $a cmp $b } @possible_namespace_names;

        if( grep( $_ ne '#default', @possible_namespace_names ) > 1 or ! @possible_namespace_names ) {
            die "No prefix found for namespace $ns, or too many possible names: ``@possible_namespace_names''; there should be just one and maybe a '#default' entry";
        }
        my $prefix = $possible_namespace_names[0];
        $xml .= ' type="' . $prefix . ':' . $self->get_name() .'"';
    }

    # nillabel ?
    return $xml .'/>' if not defined $value;

    $xml .= join q{}, '>' , $value , '';
    $xml .= "\n" if ($opt->{ readable });
    return $xml;
}

1;