File Coverage

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

Criterion	Covered	Total	%
statement	36	89	40.4
branch	8	48	16.6
condition	4	10	40.0
subroutine	6	10	60.0
pod	0	5	0.0
total	54	162	33.3

package SOAP::WSDL::XSD::ComplexType;
use strict;
use warnings;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use base qw(SOAP::WSDL::Base);

our $VERSION = $SOAP::WSDL::VERSION;

# id provided by Base
# name provided by Base
# annotation provided by Base
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 %attribute_of    :ATTR(:name  :default<()>);
my %element_of      :ATTR(:name    :default<[]>);
my %group_of        :ATTR(:name      :default<()>);
my %variety_of      :ATTR(:name    :default<()>);
my %base_of         :ATTR(:name       :default<()>);
my %itemType_of     :ATTR(:name   :default<()>);
my %abstract_of     :ATTR(:name   :default<()>);
my %final_of        :ATTR(:name      :default<()>);
my %mixed_of        :ATTR(:name      :default<()>);      # default is false

my %derivation_of   :ATTR(:name :default<()>);

# is set to simpleContent/complexContent
my %content_model_of    :ATTR(:name   :default);

sub get_flavor; *get_flavor = \&get_variety;

sub push_element {
    my $self = shift;
    my $element = shift;
    if ($variety_of{ ident $self } eq 'all')
    {
        $element->set_minOccurs(0) if not defined ($element->get_minOccurs);
        $element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
    }
    elsif ($variety_of{ ident $self } eq 'sequence')
    {
        $element->set_minOccurs(1) if not defined ($element->get_minOccurs);
        $element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
    }
    push @{ $element_of{ ident $self } }, $element;
}

sub set_restriction {
    my $self = shift;
    my $element = shift;
    $variety_of{ ident $self } = 'restriction';
    $derivation_of{ ident $self } = 'restriction';
    $base_of{ ident $self } = $element->{ Value };
}

sub set_extension {
    my $self = shift;
    my $element = shift;
    $variety_of{ ident $self } = 'extension';
    $derivation_of{ ident $self } = 'extension';
    $base_of{ ident $self } = $element->{ Value };
}

sub init {
    my $self = shift;
    my @args = @_;
    $self->SUPER::init( @args );
}

sub serialize {
    my ($self, $name, $value, $opt) = @_;

    $opt->{ indent } ||= q{};
    $opt->{ attributes } ||= [];
    my $variety = $self->get_variety();
    my $xml = ($opt->{ readable }) ? $opt->{ indent } : q{};    # add indentation

    if ( $opt->{ qualify } ) {
        $opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
        delete $opt->{ qualify };
    }

    $xml .= join q{ } , "<$name" , @{ $opt->{ attributes } };
    delete $opt->{ attributes };                                # don't propagate...

    if ( $opt->{ autotype }) {
        my $ns = $self->get_targetNamespace();
        # reverse namespace by prefix hash

        # 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 .= join q{}, " type=\"$prefix:", $self->get_name(), '" '
            if ($self->get_name() );
    }
    $xml .= '>';
    $xml .= "\n" if ( $opt->{ readable } );                 # add linebreak

    if ($self->schema) {
        if ($self->schema()->get_elementFormDefault() ne "qualified") {
            push @{$opt->{ attributes } }, q{xmlns=""}
                if ($self->get_targetNamespace() ne "");
        }
    }
    if ( ($variety eq "sequence") or ($variety eq "all") ) {
        $opt->{ indent } .= "\t";
        for my $element (@{ $self->get_element() }) {
            # resolve element ref
            #
            # Basic algorithm is like this:
            # If on serialization, we meet a element whose get_ref method
            # returns a true value, lookup the element from the
            # definitions instead, and serialize this element.
            #
            if (my $ref = $element->get_ref()) {
                $element = $opt->{ typelib }->find_element(
                    $element->expand($ref)
                );
            }

            # might be list - listify
            $value = [ $value ] if not ref $value eq 'ARRAY';

            for my $single_value (@{ $value }) {
                my $element_value;
                if (blessed $single_value) {
                    my $method = 'get_' . $element->get_name();
                    $element_value = $single_value->$method();
                }
                else {
                    $element_value = $single_value->{ $element->get_name() };
                }
                $element_value = [ $element_value ]
                    if not ref $element_value eq 'ARRAY';

                $xml .= join q{}
                    , map { $element->serialize( undef, $_, $opt ) }
                       @{ $element_value };
            }
        }
        $opt->{ indent } =~s/\t$//;
    }
    else {
        die "sorry, we just handle all and sequence types yet...";
    }
    $xml .= $opt->{ indent } if ( $opt->{ readable } ); # add indentation
    $xml .= '';
    $xml .= "\n" if ($opt->{ readable } );              # add linebreak
    return $xml;
}

1;