view release on metacpan or  search on metacpan

lib/App/soapcli.pm  view on Meta::CPAN

        else {
            undef;
        }
    };

    my $endpoint = do {
        if (defined $arg_endpoint and $arg_endpoint !~ /^#/) {
            my $url = $arg_endpoint =~ m{://} ? $arg_endpoint : slurp($arg_endpoint, {chomp=>1});
            chomp $url;
            $url =~ s/^(.*)#(.*)$/$1/;
            $url;
        }
        else {
            $wsdl->endPoint(
                defined $port ? ( port => $port ) : (),
            );
        }
    };


    my $operation = do {
        if (defined $arg_operation) {
            $arg_operation
        }
        else {
            my $o = (keys %$request)[0];
            $request = $request->{$o};
            $o;
        }
    };


    my $http = XML::Compile::Transport::SOAPHTTP->new(
        address => $endpoint,
    );

    $http->userAgent->agent("soapcli/$VERSION");
    $http->userAgent->env_proxy;

    my $action = eval {
        $wsdl->operation(
            $operation,
            defined $port ? ( port => $port ) : (),
        )->soapAction()
    };

    my $transport = $http->compileClient(
        action => $action,
    );


    $wsdl->compileCalls(
        sloppy_floats   => 1,
        sloppy_integers => 1,
        transport       => $transport,
        defined $port ? ( port => $port ) : (),
        $self->{dump_xml_request} ? ( transport => sub { print $_[0]->toString(1); goto EXIT } ) : (),
    );

    if ($self->{explain}) {
        die $wsdl->explain($operation, PERL => 'INPUT');
    }

    my ($response, $trace) = $wsdl->call($operation, $request);

    my $json = JSON::PP->new->utf8->allow_nonref;

    if ($self->{verbose}) {
        say "---";
        $trace->printRequest;
        if ($self->{yaml}) {
            say YAML::XS::Dump({ Data => { $operation => $request } });
        } else {
            say "---";
            say $json->encode({ $operation => $request });
        }
        say "---";
        $trace->printResponse;
        if ($self->{yaml}) {
            say YAML::XS::Dump({ Data => $response });
        } else {
            say "---";
            say $json->encode($response);
        }
    }
    else {
        if ($self->{yaml}) {
            print YAML::XS::Dump($response);
        } else {
            say $json->encode($response);
        }
    }

    EXIT:
    return 1;
};


1;


=head1 SEE ALSO

L<http://github.com/dex4er/soapcli>, L<soapcli>.

=head1 AUTHOR

Piotr Roszatycki <dexter@cpan.org>

=head1 LICENSE

Copyright (c) 2011-2015 Piotr Roszatycki <dexter@cpan.org>.

This is free software; you can redistribute it and/or modify it under
the same terms as perl itself.

See L<http://dev.perl.org/licenses/artistic.html>