The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# $Id: constants.c.PL,v 36.3 2012/09/26 16:10:09 jettisu Exp $
#
# (c) 1999-2012 Morgan Stanley & Co. Incorporated
# See ..../src/LICENSE for terms of distribution.
#

use English;
use File::Basename;

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

open(CONSTANTS, '>', "constants.c.$$")
  or die "Unable to open constants.c.$$: $ERRNO\n";
select(CONSTANTS);

print <<'EndOfHeader';
/*
 * This file is auto-generated by constants.c.PL
 */

/*
 * Obscene Hack Alert!!!!
 *
 * We cant seem to get the right errno macros unless we define a bunch
 * of macros, and those are all done for us in perl.h.  However, if we
 * do this on other platforms (than SGI), were getting failures
 * compiling with 5.004, due to the symbol table being too large.
 */
#if defined(__sgi)
#include "EXTERN.h"
#include "perl.h"
#endif

#include <errno.h>
#include <string.h>

/*
 * Constants were found from the following header files:
 */

EndOfHeader

#
# cmqc.h must be included first, otherwise, cmqbc.h will explode.
#
foreach my $header ( grep(/cmqc\.h$/,@headers),
		     grep(!/cmqc\.h$/,@headers) ) {
    my $filename = basename($header);
    print "#include <$filename>\n";
}
print "\n\n";

if (keys %extra_hex || keys %extra_num) {
    print <<'EndOfText';
/*
 * Constants missing from the MQ release compiled against
 * that we need in the perl code - add them for forward compatibility,
 * i.e. to allow a module compiled against MQ v5 or MQ v6 to know
 * about constants defined for MQ v7.
 */
EndOfText
    ;
    foreach my $name (sort keys %extra_hex) {
	my $value = $extra_hex{$name};
	print "#ifndef $name\n";
	printf "#define $name 0x%04x\n", $value;
	print "#endif /* $name */\n";
    }
    foreach my $name (sort keys %extra_num) {
	my $value = $extra_num{$name};
	print "#ifndef $name\n";
	print "#define $name $value\n";
	print "#endif /* $name */\n";
    }
    print "\n\n";
}

#
# Generate the constant_hex function
#
print <<'EndOfText';
MQULONG constant_hex(const char *name)
{
    errno = 0;

EndOfText

foreach $constant ( sort keys %constant_hex ) {
    print <<"EndOfText";
    if ( strcmp(name, "$constant") == 0 )
       return $constant;

EndOfText
}

print <<'EndOfText';
    errno = ENOENT;

    return 0;
}

EndOfText

#
# Generate the constant_numeric function
#
print <<'EndOfText';
MQLONG constant_numeric(const char *name)
{
    errno = 0;

EndOfText

foreach $constant ( sort keys %constant_numeric ) {
    print <<"EndOfText";
    if ( strcmp(name, "$constant") == 0 )
       return $constant;

EndOfText
}

print <<'EndOfText';
    errno = ENOENT;
    return 0;
}

EndOfText

#
# Now generate the constant_string function
#
print <<'EndOfText';
int constant_string(const char *name, char *value)
{
    errno = 0;

EndOfText

foreach $constant ( sort keys %constant_string ) {

    print <<"EndOfText";

    if ( strcmp(name, "$constant") == 0 ) {
	strcpy(value,$constant);
	return 1;
    }

EndOfText
}

print <<'EndOfText';

    errno = ENOENT;
    return 0;

}
EndOfText

#
# Now generate the constant_char function
#
print <<'EndOfText';
int constant_char(const char *name, char *value)
{
    errno = 0;

EndOfText

foreach $constant ( sort keys %constant_char ) {

    print <<"EndOfText";

    if ( strcmp(name, "$constant") == 0 ) {
	value[0] = $constant;
	return 1;
    }

EndOfText
}

print <<'EndOfText';

    errno = ENOENT;
    return 0;

}
EndOfText

close(CONSTANTS) ||
  die "Unable to close constants.c.$$: $ERRNO\n";

rename("constants.c.$$","constants.c") ||
  die "Unable to rename constants.c.$$ to constants.c: $ERRNO\n";

exit 0;