view release on metacpan or  search on metacpan

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

our $VERSION = '0.0300';

use Log::Report 'soapcli', syntax => 'SHORT';

use XML::LibXML;
use XML::Compile::WSDL11;
use XML::Compile::SOAP11;
use XML::Compile::SOAP12;
use XML::Compile::Transport::SOAPHTTP;

use Perl6::Slurp              qw(slurp);
use Getopt::Long::Descriptive ();
use HTTP::Tiny                ();
use YAML::Syck                ();
use YAML::XS                  ();
use JSON::PP                  ();


=head1 ATTRIBUTES

=over

=item argv : ArrayRef

Arguments list with options for the application.

=back

=head1 METHODS

=over

=item new (I<%args>)

The default constructor.

=cut

sub new {
    my ($class, %args) = @_;
    return bless {
        argv       => [],
        extra_argv => [],
        %args,
    } => $class;
};


=item new_with_options (%args)

The constructor which initializes the object based on C<@ARGV> variable or
based on array reference if I<argv> option is set.

=cut

sub new_with_options {
    my ($class, %args) = @_;

    my $argv = delete $args{argv};
    local @ARGV = $argv ? @$argv : @ARGV;

    my ($opts, $usage) = Getopt::Long::Descriptive::describe_options(
        "$0 %o data.yml [http://schema | schema.url] [endpoint#port] [operation]",
        [ 'verbose|v',          'verbose mode with messages trace', ],
        [ 'dump-xml-request|x', 'dump request as XML document', ],
        [ 'explain|e',          'explain webservice as Perl code', ],
        [ 'help|h',             'print usage message and exit', ],
        [ 'json|j',             'output result as JSON document', ],
        [ 'yaml|y',             'output result as YAML document', ],
    );

    die $usage->text if $opts->help or @ARGV < 1;

    return $class->new(extra_argv => [@ARGV], %$opts);
};


=item run ()

Run the main job

=back

=cut

sub run {
    my ($self) = @_;

    my $arg_request = $self->{extra_argv}->[0];
    my $servicename = do {
        if ($arg_request =~ /^{/ or $arg_request eq '-') {
            '';
        }
        else {
            my $arg = $arg_request;
            $arg =~ s/\.(url|yml|wsdl)$//;
            $arg;
        };
    };


    my $arg_wsdl = $self->{extra_argv}->[1];

    my $wsdlsrc = do {
        if (defined $self->{extra_argv}->[1]) {
            $self->{extra_argv}->[1];
        }
        else {
            my $name = $servicename;
            LOOP: {
                do {
                    if (-f "$name.wsdl") {
                        $name .= '.wsdl';
                        last;
                    }
                    elsif (-f "$name.url") {
                        $name .= '.url';
                        last;
                    };
                    $name =~ s/[._-][^._-]*$//;