view release on metacpan or  search on metacpan

lib/SOAP/Transport/MQ.pm  view on Meta::CPAN

use URI;
use URI::Escape;
use SOAP::Lite;

sub requestqueue {
    my $self = shift;
    $self = $self->new() if not ref $self;
    if (@_) {
        $self->{_requestqueue} = shift;
        return $self;
    }
    return $self->{_requestqueue};
}

sub replyqueue {
    my $self = shift;
    $self = $self->new() if not ref $self;
    if (@_) {
        $self->{_replyqueue} = shift;
        return $self;
    }
    return $self->{_replyqueue};
}

# ======================================================================

package URI::mq;    # ok, lets do 'mq://' scheme
our $VERSION = 0.712;
require URI::_server;
require URI::_userpass;

@URI::mq::ISA = qw(URI::_server URI::_userpass);

# mq://user@host:port?Channel=A;QueueManager=B;RequestQueue=C;ReplyQueue=D
# ^^   ^^^^ ^^^^ ^^^^ ^^^^^^^^^ ^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^ ^^^^^^^^^^^^

# ======================================================================

package SOAP::Transport::MQ::Client;
our $VERSION = 0.712;
use vars qw(@ISA);
@ISA = qw(SOAP::Client SOAP::Transport::MQ);

use MQSeries qw(:constants);

sub DESTROY {
    SOAP::Trace::objects('()');
}

sub new {
    my $class = shift;

    return $class if ref $class;

    my ( @params, @methods );
    while (@_) {
        $class->can( $_[0] )
          ? push( @methods, shift() => shift )
          : push( @params,  shift );
    }
    my $self = bless {@params} => $class;
    while (@methods) {
        my ( $method, $params ) = splice( @methods, 0, 2 );
        $self->$method( ref $params eq 'ARRAY' ? @$params : $params );
    }
    SOAP::Trace::objects('()');

    return $self;
}

sub endpoint {
    my $self = shift;

    return $self->SUPER::endpoint unless @_;

    my $endpoint = shift;

    # nothing to do if new endpoint is the same as the current one
    {
        no warnings qw(uninitialized);
        return $self if $self->SUPER::endpoint eq $endpoint;
    }
    my $uri        = URI->new($endpoint);
    my %parameters = (
        %$self,
        map { URI::Escape::uri_unescape($_) }
          map { split /=/, $_, 2 } split /[&;]/,
        $uri->query || ''
    );

    $ENV{MQSERVER} = sprintf "%s/TCP/%s(%s)", $parameters{Channel},
      $uri->host, $uri->port
      if $uri->host;

    my $qmgr =
      MQSeries::QueueManager->new( QueueManager => $parameters{QueueManager} )
      || die "Unable to connect to queue manager $parameters{QueueManager}\n";

    $self->requestqueue(
        MQSeries::Queue->new(
            QueueManager => $qmgr,
            Queue        => $parameters{RequestQueue},
            Mode         => 'output',
          )
          || die "Unable to open $parameters{RequestQueue}\n"
    );

    $self->replyqueue(
        MQSeries::Queue->new(
            QueueManager => $qmgr,
            Queue        => $parameters{ReplyQueue},
            Mode         => 'input',
          )
          || die "Unable to open $parameters{ReplyQueue}\n"
    );

    return $self->SUPER::endpoint($endpoint);
}

sub send_receive {
    my ( $self,     %parameters ) = @_;