Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Browse Websphere MQ Queues not possible in Perl? It is possible in VB-script...

by perl_script_guy (Initiate)
on May 14, 2010 at 08:42 UTC ( #839963=perlquestion: print w/replies, xml ) Need Help??

perl_script_guy has asked for the wisdom of the Perl Monks concerning the following question:

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__
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 line 142
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 line 139.

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

Replies are listed 'Best First'.
Re: Browse Websphere MQ Queues not possible in Perl? It is possible in VB-script...
by Corion (Pope) on May 14, 2010 at 08:47 UTC

    As you don't show us the relevant part of the VB script and how it works, we can only guess.

    I would try the following:



    $gmo->{Options} = $gmo_option;
    A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://839963]
Approved by Old_Gray_Bear
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2021-05-10 23:09 GMT
Find Nodes?
    Voting Booth?
    Perl 7 will be out ...

    Results (108 votes). Check out past polls.