#!/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(time);

#
#
#

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__

##</code><code>##

$gmo->Options($gmo_option);

##</code><code>##

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

##</code><code>##

$gmo->Options = $gmo_option;

##</code><code>##

Can't modify non-lvalue subroutine call at MQBrowse.pl line 139.