To read messages from a queue in Websphere MQ is quit easily done in Perl.
Just use the Win32::OLE package to access the ActiveX components of MQ to connect to the Queuemanager, open the Queue, Get() a message from the queue and disconnect again.
No need to use the MQSeries package.(Not possible on our Windows servers)
However, the get() method also deletes the message from the queue.
If I want to just browse the message, I have to change the GetMessageOptions-object just before I issue the Get() method.
However, Perl won't let me change this GetMessageOptions object.
Here is the code:
#!/usr/bin/perl

# Mar 2009

use strict;
use warnings;

my $inqname = q{INQUEUE};
my $Logfile = q{mqbrowse.txt};
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(tim
+e);

#
#
#

package MQ;

use Win32::OLE;
use Carp;
# requires mqax200.dll

# MQGMO_* (Get Message Options)
use constant MQGMO_BROWSE_FIRST => 16;
use constant MQGMO_BROWSE_NEXT => 32;
# MQOO_* (Open Options)
use constant MQOO_INPUT_AS_Q_DEF => 1;
use constant MQOO_INPUT_SHARED => 2;
use constant MQOO_INPUT_EXCLUSIVE => 4;
use constant MQOO_BROWSE => 8;
use constant MQOO_OUTPUT => 16;
use constant MQOO_INQUIRE => 32;
use constant MQOO_SET => 64;
use constant MQOO_BIND_ON_OPEN => 16384;
use constant MQOO_BIND_NOT_FIXED => 32768;
use constant MQOO_BIND_AS_Q_DEF => 0;
use constant MQOO_SAVE_ALL_CONTEXT => 128;
use constant MQOO_PASS_IDENTITY_CONTEXT => 256;
use constant MQOO_PASS_ALL_CONTEXT => 512;
use constant MQOO_SET_IDENTITY_CONTEXT => 1024;
use constant MQOO_SET_ALL_CONTEXT => 2048;
use constant MQOO_ALTERNATE_USER_AUTHORITY => 4096;
use constant MQOO_FAIL_IF_QUIESCING => 8192;
use constant MQOO_RESOLVE_NAMES => 65536;
use constant MQOO_RESOLVE_LOCAL_Q => 262144;

use constant MQCC_OK   => 0; 
use constant MQCC_WARNING   => 1; 
use constant MQCC_FAILED   => 2;
use constant MQCC_UNKNOWN   => -1;

sub halt_if_error {
    if (Win32::OLE->LastError != 0) {
        print main::LOG "Error: " . Win32::OLE->LastError. "\n   ";
        croak("Error: " . Win32::OLE->LastError. "\n   ");
    }
}

#

package MQ::Session;

sub new {
    return Win32::OLE->new("MQAX200.MQSession") or die;
}

#

package MQ::Message;

sub new {
    return Win32::OLE->new("MQAX200.MQMessage") or die;
}

#
#
#

package main;

use strict;
use warnings;

$| = 1;

# Declared at top of file:
# my ($inqname, $copyqname, $outqname).

open LOG, ">> $Logfile";
print LOG "Rundate time: ";
printf LOG "%4d-%02d-%02d %02d:%02d:%02d\n\n",$year+1900,$mon+1,$mday,
+$hour,$min,$sec;

# Declare objects
#
my $session = MQ::Session->new;
my $inmsg = MQ::Message->new;

# Initialize objects
#
my $qmgr = $session->AccessQueueManager("");
MQ::halt_if_error;
$qmgr->Connect();
MQ::halt_if_error;
#
my $inqueue;

my $input_options = MQ::MQOO_BROWSE | MQ::MQOO_INQUIRE;

$inqueue = $qmgr->AccessQueue($inqname, $input_options, "", "", "");
MQ::halt_if_error;

my $gmo = $session->AccessGetMessageOptions();
MQ::halt_if_error;

my $gmo_options = $gmo->Options;
MQ::halt_if_error;
my $gmo_option;
print LOG "Initialization done\n";

my $NoMoreMsg = 1;

my $msg = ReadMessage('First');

while (!$NoMoreMsg){
    $msg = ReadMessage('Next');
}

# Disconnect from Queuemanager
$qmgr->Disconnect();
MQ::halt_if_error;
print LOG "Disconnected.\n";

sub ReadMessage {
    my $ReadOption = shift;
    if ($ReadOption eq 'First'){
        $gmo_option = $gmo_options | MQ::MQGMO_BROWSE_FIRST;
    }else{
        $gmo_option = $gmo_options | MQ::MQGMO_BROWSE_NEXT;
    }
    $gmo->Options($gmo_option);
    my $temp = $gmo->Options;
    $inqueue->Get($inmsg,$gmo);
    MQ::halt_if_error;

    print LOG "CompletionCode on get " . $inqueue->CompletionCode . "\
+n";
    if ( $inqueue->CompletionCode == MQ::MQCC_WARNING ) {       
            print LOG "Warning on get " . $inqueue->ReasonName . "\n";
            $NoMoreMsg = 0;
    }
    print LOG "Get message done\n";

    # Read message
    my $datetime = $inmsg->PutDateTime;
    MQ::halt_if_error;
    print LOG "Message put on queue ", $datetime->Date("dd'-'MM'-'yyyy
+ "), $datetime->Time("hh:mm:ss tt 'GMT'"), "\n";
    
    my $replyqm = $inmsg->ReplyToQueueManagerName;
    MQ::halt_if_error;
    print LOG "Message comes from QMan $replyqm\n";
    
    my $len = $inmsg->DataLength;
    MQ::halt_if_error;
    print LOG "Message in length $len\n";
    
    $msg = $inmsg->ReadString($len);
    MQ::halt_if_error;
    print LOG "Read message[" . trimTS($msg) . "]\n";
}


sub trimTS{
    my $t = shift || return(0);
    $t =~ s/\s+$//; #remove trailing spaces
    return $t;
}

__END__

[download]
The piece of code that is not working is:
$gmo->Options($gmo_option); The next line in the code is for debugging.
The value $temp should now be 16, but is still zero.
The Get() operation failes with:
Error: OLE exception from "mqax200":

MQAX200.MQueue::Get CompletionCode = 2, ReasonCode = 6127, ReasonName 
+=
MQRC_INCONSISTENT_OPEN_OPTIONS

Win32::OLE(0.1709) error 0x80020009: "Exception occurred"
    in METHOD/PROPERTYGET "Get"
    at MQBrowse.pl line 142

[download]
This is because MQ expects a MQGMO_BROWSE_FIRST or MQGMO_BROWSE_NEXT value in the $gmo object, if the queue is opened with the MQOO_BROWSE option (btw, in the Accesqueue method the option parameter is of the type Long, In the Get method the option parameter is of the type GetMessageOptions).
If I code the failing line as:
$gmo->Options = $gmo_option; the message is:
Can't modify non-lvalue subroutine call at MQBrowse.pl line 139.

[download]

Btw, I have coded the same script in VB-script and this works.
I think we cannot just let this happen now, can we?

In reply to Browse Websphere MQ Queues not possible in Perl? It is possible in VB-script... by perl_script_guy

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.