using perl xs enums in perl scripts

Allswellthatendswell

2007-12-09 21:27:50 UTC

Post by Allswellthatendswell
Hello. I read Alexander Kolbasov's excellent blog on the pitfalls
of Perl XS with enums. I used the following xs_test.h and got
Alexander's h2xs fixes to work the way the blog described.
// xs_test.h
typedef enum mdNameNameHints {
NameFull=1,
NameInverse=2,
NameGovernmentInverse=4,
NameMixedFirst=8,
NameMixedLast=16} xst_NameHints_t;
I am now trying to call a C function by passing in one of these enum
use mdNamePerl;
my $g;
#Create
mdName Object$g=&mdNamePerl::mdNameCreate();
&mdNamePerl::mdNameSetPrimaryNameHint($g,NameFull);
mdNamePerl is a Perl XS application which glues a C/C++ application
together with Perl.
MDAPI int __stdcall mdNameSetPrimaryNameHint(mdName, enum
mdNameNameHints);
In the typemap, I have mapped enum mdNameNameHints to a T_IV(integer)
but when I run this perl program I get the error : Argument "NameFull"
isn't numeric in entersub at test.pl line 66, <CONFIG> chunk 39.
Does anyone have any ideas how I can pass the enumeration NameFull
to the perl subroutine call correctly given that I have
implemented(hopefully correctly) the h2xs fixes in Alexander's
blog ,"Pitfals of the Perl XS or what to do when things do not work as
advertised"? Thank you very much.

I have found out the source of the problem. Yesterday, I was running
my tests on a Sun Solaris 8 which did not have have the perl package
ExtUtils::Constant installed. Today, I changed to Red Hat Enterprise
Linux 5.1 which has the perl package ExtUtils::Constant installed.
Thank you.

Here is my Perl test program and the MakeFile.PL

#XS-Test1.t
# Before `make install' is performed this script should be runnable
with
# `make test'. After `make install' it should work as `perl XS-
Test1.t'

# change 'tests => 2' to 'tests => last_test_to_print';
use Test::More tests => 22;
BEGIN { use_ok('XS::Test1') };

my $fail = 0;
foreach my $constname (qw(
Aggressive Blank ConfigFile Conservative DatabaseExpired Female
FirstLast Formal Informal Male Mixed NameFull NameGovernmentInverse
NameInverse NameMixedFirst NameMixedLast Neutral NoError Slug
Unknown)) {
next if (eval "my \$a = $constname; 1");
if ($@ =~ /^Your vendor has not defined XS::Test1 macro $constname/)
{
print "# pass: $@";
} else {
print "# fail: $@";
$fail = 1;
}

}

ok( $fail == 0 , 'Constants' );
########################

# Insert your test code below, the Test::More module is use()ed here
so read
# its man page ( perldoc Test::More ) for help writing this test
script.
is(NoError,0);
is(ConfigFile,1);
is(DatabaseExpired,2);
is(Unknown,3);
is(NameFull,1);
is(NameInverse,2);
is(NameGovernmentInverse,4);
is(NameMixedFirst,8);
is(NameMixedLast,16);
is(Male,1);
is(Mixed,2);
is(Female,3);
is(Aggressive,1);
is(Neutral,2);
is(Conservative,3);
is(Formal,0);
is(Informal,1);
is(FirstLast,2);
is(Slug,3);
is(Blank,4);

my $record;
my $g;

#Create mdName Object
$g=&XS::Test1::mdNameCreate();

#Set Master License String
&XS::Test1::mdNameSetLicenseString($g,"b1cac9c8cfcc0162");

#Set Path to Name File
&XS::Test1::mdNameSetPathToNameFiles($g,"/home/frankc/Test/
mdNameTest/Distribution");

if(&XS::Test1::mdNameInitializeDataFiles($g) != NoError)
{
diag( "Failed to Initialize mdName::mdName ".
&XS::Test1::mdNameGetInitializeErrorString($g)."\n");
}

#Check build number method
diag( "Build Number: " .&XS::Test1::mdNameGetBuildNumber($g).
"\n") ;

#Database Date
diag( "Database Date: " .&XS::Test1::mdNameGetDatabaseDate($g).
"\n");

#Check expiration date
diag( "Expiration Date: " .&XS::Test1::mdNameGetExpirationDate($g).
"\n");

&XS::Test1::mdNameSetFirstNameSpellingCorrection($g,1);

# open file handle
open CONFIG, "/home/frankc/Test/mdNameTest/Distribution/DemoData/
mdName.sdf";

while ($record = <CONFIG>) {
$record =~ s/^\s+//; #remove leading whitespaces
$record =~ s/\s+$//; #remove trailing whitespaces

diag( "FullName: " .$record. "\n");

&XS::Test1::mdNameClearProperties($g);

&XS::Test1::mdNameSetFullName($g,$record);

&XS::Test1::mdNameSetPrimaryNameHint($g,NameFull);
&XS::Test1::mdNameSetSecondaryNameHint($g,NameInverse);

# Parse the fullname
&XS::Test1::mdNameParse($g);

#Gender
diag( "Gender: " .&XS::Test1::mdNameGetGender($g). "\n");

#Prefix
diag( "Prefix: " .&XS::Test1::mdNameGetPrefix($g). "\n");

#First Name
diag( "First Name: " .&XS::Test1::mdNameGetFirstName($g). "\n");

#Middle Name
diag( "Middle Name: " .&XS::Test1::mdNameGetMiddleName($g). "\n");

#Last Name
diag( "Last name: " .&XS::Test1::mdNameGetLastName($g). "\n");

#Suffix
diag( "Suffix: " .&XS::Test1::mdNameGetSuffix($g). "\n");

#Gender2
diag( "Gender 2: " .&XS::Test1::mdNameGetGender2($g). "\n");

#Prefix2
diag( "Prefix 2: " .&XS::Test1::mdNameGetPrefix2($g). "\n");

#First Name2
diag( "First Name 2: " .&XS::Test1::mdNameGetFirstName2($g). "\n");

#Middle Name2
diag( "Middle Name 2: " .&XS::Test1::mdNameGetMiddleName2($g).
"\n");

#Last Name2
diag( "Last name 2: " .&XS::Test1::mdNameGetLastName2($g). "\n");

#Suffix2
diag( "Suffix2: " .&XS::Test1::mdNameGetSuffix2($g). "\n");

#Salutation
diag( "Salutation: " .&XS::Test1::mdNameGetSalutation($g). "\n");

#Status Code
diag( "Status Code: " .&XS::Test1::mdNameGetStatusCode($g). "\n");

#Error Code
diag( "Error Code: " .&XS::Test1::mdNameGetErrorCode($g). "\n");

#Change Code
diag( "Change Code: " .&XS::Test1::mdNameGetChangeCode($g). "\n");
}

close CONFIG;

##########################################################################################

#MakeFile.PL
use 5.008008;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'XS::Test1',
VERSION_FROM => 'lib/XS/Test1.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/XS/Test1.pm', # retrieve abstract from
module
AUTHOR => 'Frank Chang <***@localdomain>') : ()),
LIBS => ['-L/home/frankc/Test/mdNameTest/liunkg_deb -
lmdName'], # e.g., '-lm'
DEFINE => '', # e.g., '-DHAVE_SOMETHING'
INC => '-I.', # e.g., '-I. -I/usr/include/other'
# Un-comment this if you add C files to link with later:
# OBJECT => '$(O_FILES)', # link all the C files too
);
if (eval {require ExtUtils::Constant; 1}) {
# If you edit these definitions to change the constants used by this
module,
# you will need to use the generated const-c.inc and const-xs.inc
# files to replace their "fallback" counterparts before distributing
your
# changes.
my @names = ({name=>"Aggressive", macro=>"1"},
{name=>"Blank", macro=>"1"},
{name=>"ConfigFile", macro=>"1"},
{name=>"Conservative", macro=>"1"},
{name=>"DatabaseExpired", macro=>"1"},
{name=>"Female", macro=>"1"},
{name=>"FirstLast", macro=>"1"},
{name=>"Formal", macro=>"1"},
{name=>"Informal", macro=>"1"},
{name=>"Male", macro=>"1"},
{name=>"Mixed", macro=>"1"},
{name=>"NameFull", macro=>"1"},
{name=>"NameGovernmentInverse", macro=>"1"},
{name=>"NameInverse", macro=>"1"},
{name=>"NameMixedFirst", macro=>"1"},
{name=>"NameMixedLast", macro=>"1"},
{name=>"Neutral", macro=>"1"},
{name=>"NoError", macro=>"1"},
{name=>"Slug", macro=>"1"},
{name=>"Unknown", macro=>"1"});
ExtUtils::Constant::WriteConstants(
NAME => 'XS::Test1',
NAMES => \@names,
DEFAULT_TYPE => 'IV',
C_FILE => 'const-c.inc',
XS_FILE => 'const-xs.inc',
);

}
else {
use File::Copy;
use File::Spec;
foreach my $file ('const-c.inc', 'const-xs.inc') {
my $fallback = File::Spec->catfile('fallback', $file);
copy ($fallback, $file) or die "Can't copy $fallback to $file:
$!";
}
}