use strict; use warnings;

use LWP::UserAgent;

my $f_temp = shift || 68;
my $url    = 'http://localhost:8080/GantrySoapService/f2c';

my $site = {
    action_url       => $url,
    post_to_url      => $url,
    target_namespace => 'http://sunflower.com/soapns',
};

my $request_args = [
    {
        temperature => [
            { farenheit => $f_temp },
        ]
    },
];

my $request_xml = form_xml( $site, $request_args, 1 );

warn "request:\n$request_xml\n";

transact_via_xml( $site, $request_xml );

sub form_xml {
    my $size         = shift;
    my $request_args = shift;
    my $pretty       = shift;

    my $args = build_args( $request_args, $pretty );

    return <<"EO_XML";
<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
               xmlns:tns="$site->{ target_namespace }"
               xmlns:xs="http://www.w3.org/2001/XMLSchema" >
<soap:Body>
$args
</soap:Body>
</soap:Envelope>
EO_XML
}

sub build_args { # recursive
    my $request_args = shift;
    my $pretty       = shift;
    my $depth        = shift || 0;
    my $retval       = '';

    return $request_args unless ref( $request_args ) eq 'ARRAY';

    # pretty printed for debugging:
    my $indent       = ( $pretty ) ? ' ' x ( 2 * $depth ) : '';
    my $nl           = ( $pretty ) ? "\n"                 : '';

    foreach my $arg ( @{ $request_args } ) {
        my ( $key, $values ) = %{ $arg };

        if ( $values ) {
            my $start_tag    = "$indent<tns:$key>";
            my $child_output = build_args( $values, $pretty, $depth + 
+1 );
            my $end_tag      = "</tns:$key>$nl";

            # now pretty print it pretty please
            if ( ref( $values ) eq 'ARRAY' ) {
                $start_tag = "$start_tag$nl";
                $end_tag   = "$indent$end_tag";
            }

            $retval      .= "$start_tag$child_output$end_tag";
        }
        else {  # values is undef or the empty string
            $retval .= "$indent<tns:$key/>$nl";
        }
    }

    return $retval;
}

sub transact_via_xml {
    my ( $site, $request_xml ) = @_;

    # make the request
    my $user_agent = LWP::UserAgent->new();
    $user_agent->agent( 'Sunflower/1.0' );

    my $request = HTTP::Request->new(
        POST => $site->{ post_to_url }
    );

    $request->content_type( 'text/xml; charset=utf-8' );
    $request->content_length( length $request_xml );
    $request->header( 'Host' => $site->{host} );
    $request->header( 'SoapAction' => $site->{ action_url } );
    $request->content( $request_xml );

    my $response = $user_agent->request( $request );

    warn $response->content . "\n";
}
[download]