our
$VERSION
=
'1.30'
;
our
@ISA
=
qw(MQSeries::Message)
;
require
"MQSeries/Message/ConfigEvent.pl"
;
require
"MQSeries/Command/PCF/ResponseParameters.pl"
;
sub
GetConvert {
my
(
$this
,
$buffer
) =
@_
;
$this
->{Buffer} =
$buffer
;
my
$offset
= 0;
my
$retval
= {};
my
$type
=
$this
->_readNumber(
$buffer
, 0, 4);
my
$length
=
$this
->_readNumber(
$buffer
, 4, 4);
my
$version
=
$this
->_readNumber(
$buffer
, 8, 4);
my
$reason
=
$this
->_readNumber(
$buffer
, 28, 4);
confess
"Invalid type [$type] (not MQCFT_EVENT)"
unless
(
$type
== MQSeries::MQCFT_EVENT);
confess
"Unexpected version [$version] (not MQCFH_VERSION_2)"
unless
(
$version
== 2) ;
$retval
->{Version} =
$version
;
$retval
->{Reason} =
$reason
.
" - "
. MQReasonToText(
$reason
);
confess
"Unknown reason [$reason]"
unless
(
defined
MQReasonToText(
$reason
));
$offset
+=
$length
;
while
(
$offset
<
length
$buffer
) {
$length
=
$this
->_readNumber(
$buffer
,
$offset
+4, 4);
$type
=
$this
->_readNumber(
$buffer
,
$offset
, 4);
my
$id
=
$this
->_readNumber(
$buffer
,
$offset
+8, 4);
next
if
(
$id
== 27);
my
$label
=
$MQSeries::Message::ConfigEvent::ResponseParameters
{
$id
};
if
(!
defined
$label
&&
defined
$retval
->{ObjectType}) {
my
$rg
=
$MQSeries::Command::PCF::ResponseParameters
{
$retval
->{ObjectType} } || {};
foreach
my
$param
(
keys
%$rg
) {
my
$macro
=
$rg
->{
$param
}[0];
if
(
$macro
==
$id
) {
$label
=
$param
;
last
;
}
}
}
my
$value
;
if
(
$type
== MQSeries::MQCFT_STRING) {
my
$datalen
=
$this
->_readNumber(
$buffer
,
$offset
+16, 4);
my
$bytes
=
$this
->_readByte(
$buffer
,
$offset
+20,
$datalen
);
$value
= Convert::EBCDIC::ebcdic2ascii(
$bytes
);
$value
=~ s!\s+$!!;
}
elsif
(
$type
== MQSeries::MQCFT_STRING_LIST) {
my
$count
=
$this
->_readNumber(
$buffer
,
$offset
+16, 4);
confess
"Invalid [$label] entry (list with length zero) at offset [$offset]"
unless
(
$count
);
my
$data
= [];
my
$loff
= 20;
my
$str_len
=
$this
->_readNumber(
$buffer
,
$loff
, 4);
$loff
+= 4;
foreach
my
$entry
(1..
$count
) {
my
$bytes
=
$this
->_readByte(
$buffer
,
$loff
,
$str_len
);
$loff
+=
$str_len
;
$bytes
= Convert::EBCDIC::ebcdic2ascii(
$bytes
);
$bytes
=~ s!\s+$!!;
push
@$data
,
$bytes
;
}
$value
=
$data
;
}
elsif
(
$type
== 9) {
my
$datalen
=
$this
->_readNumber(
$buffer
,
$offset
+12, 4);
my
$bytes
=
$this
->_readByte(
$buffer
,
$offset
+16,
$datalen
);
$bytes
=~ s!(.)!
sprintf
(
"%02x "
,
ord
($1))!eg;
$value
=
$bytes
;
}
elsif
(
$type
== MQSeries::MQCFT_INTEGER) {
$value
=
$this
->_readNumber(
$buffer
,
$offset
+12, 4);
my
$enum
=
$MQSeries::Message::ConfigEvent::ResponseEnums
{
$label
};
my
$renum
=
$MQSeries::Command::PCF::ResponseValues
{
$label
};
if
(
defined
$enum
) {
if
(
defined
$enum
->{
$value
}) {
$value
=
$enum
->{
$value
};
}
else
{
$value
.=
" - <unknown $label>"
;
}
}
elsif
(
defined
$renum
) {
foreach
my
$key
(
keys
%$renum
) {
my
$rval
=
$renum
->{
$key
};
next
unless
(
$value
==
$rval
);
$value
=
$key
;
last
;
}
}
else
{
}
}
elsif
(
$type
== 5 ) {
my
$count
=
$this
->_readNumber(
$buffer
,
$offset
+12, 4);
confess
"Invalid [$label] entry (list with length zero) at offset [$offset]"
unless
(
$count
);
my
$data
= [];
my
$loff
= 16;
foreach
my
$entry
(1..
$count
) {
my
$lvalue
=
$this
->_readNumber(
$buffer
,
$offset
+
$loff
, 4);
$loff
+= 4;
my
$enum
=
$MQSeries::Message::ConfigEvent::ResponseEnums
{
$label
};
my
$renum
=
$MQSeries::Command::PCF::ResponseValues
{
$label
};
if
(
defined
$enum
) {
if
(
defined
$enum
->{
$lvalue
}) {
$lvalue
=
$enum
->{
$lvalue
};
}
else
{
$lvalue
.=
" - <unknown $label>"
;
}
}
elsif
(
defined
$renum
) {
foreach
my
$key
(
keys
%$renum
) {
my
$rval
=
$renum
->{
$key
};
next
unless
(
$lvalue
==
$rval
);
$lvalue
=
$key
;
last
;
}
}
else
{
}
push
@$data
,
$lvalue
;
}
$value
=
$data
;
}
else
{
confess
"Unexpected chunk type [$type] for id [$id] [$label] at offset [$offset]"
;
}
unless
(
defined
$label
) {
print
STDERR
"Unexpected chunk id [$id] with value [$value] at offset [$offset] for object type [$retval->{ObjectType}]\n"
;
next
;
}
$retval
->{
$label
} =
$value
;
}
continue
{
$offset
+=
$length
;
}
return
$retval
;
}
sub
PutConvert {
confess
"Creating / Putting Config Event messages is not supported"
;
}
sub
_readNumber {
my
$class
=
shift
;
my
(
$data
,
$offset
,
$length
) =
@_
;
return
unpack
(
"N"
,
substr
(
$data
,
$offset
,
$length
));
}
sub
_readByte {
my
$class
=
shift
;
my
(
$data
,
$offset
,
$length
) =
@_
;
return
substr
(
$data
,
$offset
,
$length
);
}
1;