The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# $Id: MQSC.pm,v 33.2 2009/07/10 18:27:59 biersma Exp $
#
# (c) 1999-2009 Morgan Stanley & Co. Incorporated
# See ..../src/LICENSE for terms of distribution.
#

package MQSeries::Command::MQSC;

use strict;

our @ISA = qw(MQSeries::Command);
our $VERSION = '1.30';

use MQSeries qw(:functions);

#
# Note -- the order is important, so resist the anal retentive urge to
# sort these lines in the interest of cosmetic appearance.
#
require "MQSeries/Command/MQSC/RequestValues.pl";
require "MQSeries/Command/MQSC/RequestParameterRemap.pl";
require "MQSeries/Command/MQSC/RequestParameterPrimary.pl";
require "MQSeries/Command/MQSC/RequestParameters.pl";
require "MQSeries/Command/MQSC/RequestArgs.pl";
require "MQSeries/Command/MQSC/Requests.pl";
require "MQSeries/Command/MQSC/ResponseValues.pl";
require "MQSeries/Command/MQSC/ResponseParameters.pl";
require "MQSeries/Command/MQSC/Responses.pl";
require "MQSeries/Command/MQSC/SpecialParameters.pl";

#
# This is a bit wierd....  well, all of the MQSC stuff is wierd....
# I'll try to stop whining all over the comments.
#
# The MQSC response starts with an indicator of the total number of
# messages, then has data messages, then ends on an end line.  This
# basically checks whether the total number of messages, as indicated
# up front, has been received.
#
sub _LastSeen {
    my $self = shift;

    return unless ($self->{Response}->[0] &&
                   $self->{Response}->[0]->Header('LastMsgSeqNumber') == scalar @{$self->{Response}});

    return 1;
}


sub _ProcessResponses {
    my $self = shift;
    my $command = shift;

    my $MQSCHeader = { Command => $command };

    my $MQSCMsgDesc = {};
    my $MQSCParameters = {};

    #
    # Key difference with PCF: we are going to toss out some of the
    # responses, and reset the Response array.
    #
    my @responses;

    $self->{Buffers} = [];

    foreach my $response ( @{$self->{Response}} ) {
        #
        # XXX -- Special hack to collect raw text
        #
        push(@{$self->{Buffers}},$response->{Buffer});

        #
        # Let the object-wide compcode and reason be the first
        # non-zero result found in all of the messages.  This is
        # *usually* good enough, but the data will be available via
        # Response() if you want to parse the full header for each
        # message.
        #
        if (
            $self->{"CompCode"} == MQSeries::MQCC_OK &&
            $self->{"Reason"} == MQSeries::MQRC_NONE &&
            (
             $response->Header("CompCode") != MQSeries::MQCC_OK ||
             $response->Header("Reason") != MQSeries::MQRC_NONE
            )
           ) {
            $self->{"CompCode"} = $response->Header("CompCode");
            $self->{"Reason"} = $response->Header("Reason");
        }

        if ( $command eq 'InquireChannelStatus' ) {
            if (
                (
                 $self->{"CompCode"} == 0 &&
                 $self->{"Reason"} == 4
                ) ||
                $response->ReasonText() =~ /no chstatus found/mi
               ) {
                $response->{Parameters}->{ChannelStatus} = 'NotFound';
                $self->{"Reason"} = MQSeries::MQRCCF_CHL_STATUS_NOT_FOUND;
            }
        }

        #
        # Ok, now it gets even more complicated (yes, that is
        # always possible).
        #
        # Remember that we are trying very hard to have one
        # interface, and one format for the results.  PCF has
        # these InquireFooNames calls, that do *not* map
        # cleanly to MQSC.  We need to collect the multiple
        # messages into one, to keep the results in the same
        # format
        #
        if ( $MQSeries::Command::MQSC::ResponseList{$command} ) {
            my ($oldkey,$newkey) = @{$MQSeries::Command::MQSC::ResponseList{$command}};
            push(@{$MQSCParameters->{$newkey}},$response->Parameters($oldkey))
              if $response->Parameters($oldkey);
            # Save the last response's MsgDesc.  See below...
            $MQSCMsgDesc = $response->MsgDesc();
        } else {
            push(@responses, $response);
        }
    }                           # End foreach: response

    #
    # For these commands, we create a fake response message, and feed
    # that back.  These are:
    #
    # InquireProcessNames
    # InquireQueueNames
    # InquireChannelNames
    # InquireNamelistNames
    #
    # We're ignoring the raw responses above, and simply extracting
    # the single key we care about, and creating a fake response with
    # one parameter, and one value (an ARRAY ref of values,
    # eg. QNames).
    #
    if ( $MQSeries::Command::MQSC::ResponseList{$command} ) {
        my $response = MQSeries::Command::Response->new
          (
           MsgDesc              => $MQSCMsgDesc,
           Header               => $MQSCHeader,
           Parameters           => $MQSCParameters,
           Type                 => $self->{Type},
          ) || do {
              $self->{"CompCode"} = MQSeries::MQCC_FAILED;
              $self->{"Reason"} = MQSeries::MQRC_UNEXPECTED_ERROR;
              return;
          };
        push(@responses, $response);
    }

    #
    # Reset the Response list, since we're about to re-populate it.
    #
    $self->{Response} = [];

    #
    # Only send back responses which have non-empty parameters.
    # And yes, we're violating the OO concept of using methods
    # to get at data members.  We're somewhat incestuous here...
    #
    if ( @responses ) {
        my $responsecount = 0;
        foreach my $response ( @responses ) {
            if ( keys %{$response->{Parameters}} ) {
                $response->{Header}->{MsgSeqNumber} = ++$responsecount;
                $response->{Header}->{Control} = MQSeries::MQCFC_NOT_LAST;
                $response->{Header}->{ParameterCount} = scalar keys %{$response->{Parameters}};
                delete $response->{Header}->{LastMsgSeqNumber};
                push(@{$self->{Response}},$response);
            }
        }
        #
        # Yank back the last response, and set its control value
        # to MQCFC_LAST
        #
        if ( scalar(@{$self->{Response}}) ) {
            my $response = pop(@{$self->{Response}});
            $response->{Header}->{Control} = MQSeries::MQCFC_LAST;
            push(@{$self->{Response}},$response);
        }
        #
        # One last thing.  If we now have *no* responses, then
        # pass back the first one.  This is possible if we get
        # multiple responses, but none have parameters.
        #
        else {
            $responses[0]->{Header}->{MsgSeqNumber} = 1;
            $responses[0]->{Header}->{Control} = MQSeries::MQCFC_LAST;
            $responses[0]->{Header}->{ParameterCount} = 0;
            delete $responses[0]->{Header}->{LastMsgSeqNumber};
            push(@{$self->{Response}}, $responses[0]);
        }
    }

    return 1;
}


1;