The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
# Parse the headers to find all MQRC_xxx constants, then check the
# files with reason code numbers / constants.  Those files,
# themselves, are pre-processed later.
#
# (c) 2009 Morgan Stanley & Co. Incorporated
# See ..../src/LICENSE for terms of distribution.
#

require "util/parse_config";
require "util/parse_headers";

#
# Get all the reason codes from the MQ header files
#
my %reason_codes;               # Code -> text/undef
my $maxlength = 31;             # Match old layout
foreach my $key (sort keys %constant_numeric) {
    next unless ($key =~ /^MQRC_/ || $key =~ /^MQRCCF_/);
    $reason_codes{$key} = undef;
    $maxlength = length($key) if ($maxlength < length($key));
}

#
# Open the existing file of reason descriptions, and extract
# existing descriptions.
#
my $text_file = "pre.in/MQSeries/Constants/ReasonText.in";
my $found = 0;
open (TEXT, '<', $text_file) ||
  die "Cannot open reason text file: $!";
while (my $line = <TEXT>) {
    next unless ($line =~ /& ( (?:MQRC|MQRCCF)? _ \S+) \s+ => \s+ " ([^"]+) ",/x);
    my ($reason, $text) = ($1, $2);
    if (exists $reason_codes{$reason}) {
        $reason_codes{$reason} = $text;
        $found++;
    } else {
        warn "Have unknown reason '$reason' with text '$text'\n";
    }
}
close(TEXT);
#print "Found $found text descriptions for ", scalar(keys %reason_codes), " reason codes\n";

#
# Come up with a (poor) text description for unknown erason codes.
#
my %terms = map { ($_,1) } qw(DB2 SSL LDAP CFSF SOAP BMHO URL UOW
                              JSSE RFH CFGR API SCO PD JMS UCS2 XCF
                              DMPO SRO PCF CF IMPO CTLO XA MQSC
                             );
while (my ($reason, $text) = each %reason_codes) {
    next if (defined $text);
    my $text = $reason;
    $text =~ s/^.*?_//;         # Trim leading MQRC_
    $text =~ s/Q_/QUEUE_/g;
    $text =~ s/Q$/QUEUE/g;
    $text =~ s/_/ /g;
    $text =~ s/(\S+)/defined $terms{$1} ? $1 : lc($1)/ge; # Lower case each word
    $text = ucfirst($text);
    $text .= '.';
    $reason_codes{$reason} = $text;
}


foreach my $type (qw( ReasonText ReasonMacro)) {
    open (my $outfile, '>', "/tmp/$type.in") ||
      die "Cannot open output file $type.in: $!";
    print $outfile <<"EndOfHeader";
# -*-perl-*-
#
# WARNING: This file is automatically generated.
# Any changes made here will be mercilessly lost.
#
# You have been warned, infidel.
#
# This file is auto-generated by parsing the IBM MQSeries header
# files.  To see how this is done in all its glory (or lack thereof),
# see:
#
#    ..../src/util/extract_reason_codes
#
# \$Id: extract_reason_codes,v 33.1 2009/07/02 17:13:47 biersma Exp $
#
# (c) 1999-2009 Morgan Stanley & Co. Incorporated
# See ..../src/LICENSE for terms of distribution.
#

package MQSeries::Constants;

%$type =
  (
EndOfHeader
    ;

    foreach $reason (sort keys %reason_codes) {
        print $outfile "   &$reason" . " " x ($maxlength - length($reason)) . " => ";
        if ($type eq 'ReasonMacro') {
            print $outfile qq{"$reason",\n};
        } else {
            print $outfile qq{"$reason_codes{$reason}",\n};
        }
    }

    print $outfile <<"EndOfFooter";
  );

1;
EndOfFooter
    ;

    close($outfile) || die "Unable to close output file: $!\n";
}