File Coverage

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

Criterion	Covered	Total	%
statement	42	42	100.0
branch	22	22	100.0
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	75	75	100.0

#!/usr/bin/perl -w
package SOAP::WSDL::Serializer::XSD;
use strict;
use warnings;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);

our $VERSION = 3.003;

use SOAP::WSDL::Factory::Serializer;

my $SOAP_NS = 'http://schemas.xmlsoap.org/soap/envelope/';
my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance';

sub serialize {
    my ($self, $args_of_ref) = @_;

    my $opt = $args_of_ref->{ options };

    if (not $opt->{ namespace }->{ $SOAP_NS })
    {
        $opt->{ namespace }->{ $SOAP_NS } = 'SOAP-ENV';
    }

    if (not $opt->{ namespace }->{ $XML_INSTANCE_NS })
    {
        $opt->{ namespace }->{ $XML_INSTANCE_NS } = 'xsi';
    }

    my $soap_prefix = $opt->{ namespace }->{ $SOAP_NS };

    # envelope start with namespaces
    my $xml = qq|<$soap_prefix\:Envelope |;

    for my $uri ( sort { $a cmp $b } keys %{ $opt->{ namespace } } )
    {
        my $prefix = $opt->{ namespace }->{ $uri };
        $xml .= "xmlns:$prefix=\"$uri\" ";
    }
    #
    # add namespace for user-supplied prefix if needed
    $xml .= "xmlns:$opt->{prefix}=\"" . $args_of_ref->{ body }->get_xmlns() . "\" "
        if $opt->{prefix};

    # TODO insert encoding
    $xml.='>';
    $xml .= $self->serialize_header($args_of_ref->{ method }, $args_of_ref->{ header }, $opt);
    $xml .= $self->serialize_body($args_of_ref->{ method }, $args_of_ref->{ body }, $opt);
    $xml .= '';
    return $xml;
}

sub serialize_header {
    my ($self, $method, $data, $opt) = @_;

    # header is optional. Leave out if there's no header data
    return q{} if not $data;
    return join ( q{},
        "<$opt->{ namespace }->{ $SOAP_NS }\:Header>",
        blessed $data ? $data->serialize_qualified : (),
        "{ namespace }->{ $SOAP_NS }\:Header>",
    );
}

sub serialize_body {
    my ($self, $method, $data, $opt) = @_;

    # TODO This one wipes out the old class' XML name globally
    # Fix in some more appropriate place...
    $data->__set_name("$opt->{prefix}:" . $data->__get_name() ) if $opt->{prefix};

    # Body is NOT optional. Serialize to empty body
    # if we have no data.
    return join ( q{},
        "<$opt->{ namespace }->{ $SOAP_NS }\:Body>",
        defined $data
            ? ref $data eq 'ARRAY'
                ? join q{}, map { blessed $_ ? $_->serialize_qualified() : () } @{ $data }
                : blessed $data
                    ? $opt->{prefix}
                        ? $data->serialize()
                        : $data->serialize_qualified()
                    : ()
            : (),
        "{ namespace }->{ $SOAP_NS }\:Body>",
    );
}

__END__