Often code exists in C libraries and a Perl programmer will want to use the C code from within Perl. A number of ways are possible - Inline::C, SWIG, however the most flexible (and possibly difficult) method is to use XS. A very good introductory tutorial is available.
For illustration, we define a header file (admittedly convoluted) which includes a structure containing a union to demonstrate that we can access arbitrarily nested data structure. The header file is given as :
#ifndef TEST_H
#define TEST_H
#include <malloc.h>
#include <stdio.h>
#include <string.h>
#define MAXSIZE 32
typedef union _SIGMA {
long sum;
long diff;
} SIGMA, *PSIGMA;
typedef struct _HEADFOOT {
short alpha;
short beta;
SIGMA* sigma;
char* file;
} HEADFOOT, *PHEADFOOT;
HEADFOOT* new(const char *);
short get_alpha(HEADFOOT*);
short get_beta(HEADFOOT*);
long get_sigma(HEADFOOT*);
char* get_file(HEADFOOT*);
#endif
We would like to be able to use this information naturally from within Perl. A sample Perl program which might be written for access could be :
#!/usr/bin/perl -w
use strict;
use ReadStruct;
(@ARGV == 1) or die "Please pass a filename";
my $filename = $ARGV[0];
my $struct = ReadStruct->new($filename);
warn "\nREF is ", ref $struct, "\n";
my $file = $struct->file;
warn "FILE is $file\n";
my $alpha = $struct->alpha;
printf("alpha is %#hx\n", $alpha);
my $beta = $struct->beta;
printf("beta is %#hx\n", $beta);
my $sigma = $struct->sigma;
printf("sigma is %#lx\n", $sigma);
The code associated with this header file is given as :
#include "read_struct.h"
HEADFOOT* new(const char* filename)
{
FILE *fh;
HEADFOOT* my_headfoot;
char* my_file;
SIGMA* my_sigma;
if ((my_file = malloc((strlen(filename) + 1) * sizeof(char))) == NULL)
printf("file - no memory\n");
snprintf(my_file, MAXSIZE, "%s", filename);
if ((my_sigma = malloc(sizeof(SIGMA))) == NULL)
printf("sigma - no memory\n");
if ((my_headfoot = malloc(sizeof(HEADFOOT))) == NULL)
printf("ptr - no memory\n");
printf("Processing %s\n", filename);
fh = fopen( filename, "rb" );
if( fh == NULL )
{
printf( "Cannot open %s\n", filename );
return NULL;
}
fread(my_headfoot, sizeof(short) + sizeof(short), 1, fh);
my_headfoot->sigma = my_sigma;
if (my_headfoot->alpha > my_headfoot->beta) {
my_headfoot->sigma->diff = my_headfoot->alpha - my_headfoot->beta;
} else {
my_headfoot->sigma->sum = my_headfoot->alpha + my_headfoot->beta;
}
my_headfoot->file = my_file;
return (my_headfoot);
}
short
get_alpha(HEADFOOT* ptr)
{
return ptr->alpha;
}
short
get_beta(HEADFOOT* ptr)
{
return ptr->beta;
}
long
get_sigma(HEADFOOT* ptr)
{
if (ptr->alpha > ptr->beta) {
printf("sigma - diff\n");
return ptr->sigma->diff;
} else {
printf("sigma - sum\n");
return ptr->sigma->sum;
}
}
char *
get_file(HEADFOOT* ptr)
{
return ptr->file;
}
The constructor new builds and initialises the data structure. All other functions are accessors for the data.
We use the C utility h2xs which is supplied with Perl, to produce an initial working (and incomplete) interface. Then we patch the autogenerated files to achieve our objective.
We invoke h2xs via :
h2xs -On ReadStruct ./src/read_struct.h
A number of files are created by the command.
Defaulting to backwards compatibility with perl 5.10.1 If you intend this module to be compatible with earlier perl versions, please specify a minimum perl version with the -b option. Writing ReadStruct/ppport.h Writing ReadStruct/lib/ReadStruct.pm Writing ReadStruct/ReadStruct.xs Writing ReadStruct/fallback/const-c.inc Writing ReadStruct/fallback/const-xs.inc Writing ReadStruct/Makefile.PL Writing ReadStruct/README Writing ReadStruct/t/ReadStruct.t Writing ReadStruct/Changes Writing ReadStruct/MANIFEST
We need to change the auto-generated XS file from :
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include <./src/read_struct.h> #include "const-c.inc" MODULE = ReadStruct PACKAGE = ReadStruct INCLUDE: const-xs.inc
to
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include "ppport.h"
6
7 #include <./src/read_struct.h>
8
9 #include "const-c.inc"
10
11 typedef HEADFOOT *ReadStruct;
12
13 MODULE = ReadStruct PACKAGE = ReadStruct PREFIX = get_
14
15 INCLUDE: const-xs.inc
16
17 PROTOTYPES: ENABLE
18
19 ReadStruct
20 new(package, filename);
21 const char * package
22 const char * filename
23 CODE:
24 RETVAL = new(filename);
25 OUTPUT:
26 RETVAL
27
28 int
29 get_alpha(headfoot)
30 ReadStruct headfoot
31
32 int
33 get_beta(headfoot)
34 ReadStruct headfoot
35
36 int
37 get_sigma(headfoot)
38 ReadStruct headfoot
39
40 char *
41 get_file(headfoot)
42 ReadStruct headfoot
43
44 void
45 DESTROY(headfoot)
46 ReadStruct headfoot
47 CODE:
48 printf("Now in ReadStruct::DESTROY\n");
49 free( headfoot->file );
50 free( headfoot->sigma );
51 free( headfoot );
The line numbers are given to allow annotation.
Line 11 - We define the C type HEADFOOT* to be a ReadStruct.
Line 13 - We add the PREFIX = get_ stanza to remove the prefix from C methods when called from Perl.
Line 17 - We enable prototypes.
Line 19 - ReadStruct is really (from line 11) a HEADFOOT* to allow us to access the structure pointer as a Perl object.
Line 20 - The Perl constuctor call implicitly passes a package as the first parameter.
Line 21 - So we drop it from the argument stack.
Line 23 - The CODE: signifies that we supply our own code here.
Line 24 - So we call the C new function and assign it to RETVAL
Line 26 - and then output this pointer.
The accessors use XS defaults to access the C accessors.
Since we have defined the type ReadStruct in line 11, we need to let C know how to handle this type. We do so by constructing a file called typemap.The contents define our user type in terms of those XS knows about.
TYPEMAP ReadStruct T_PTROBJ
We need to modify the auto-generated Makefile.PL so that our library (of the compiled C code above) is accessible.
The diff to the patched Makefile.PL is given by :
12a13
> MYEXTLIB => 'src/libreadstruct.so',
40a42,50
>
> sub MY::postamble {
> '
> $(MYEXTLIB): src/Makefile
> cd src && make
> ';
> }
>
>
We change the auto-generated test program, ReadStruct/t/ReadStruct.t, by adding some Perl code. The diff is given as:
8c8,9
< use Test::More tests => 2;
---
> use Test::More tests => 7;
> #use Test::More tests => 2;
30a32,51
> my $struct = ReadStruct->new("/etc/motd");
> warn "\nREF is ", ref $struct, "\n";
> ok( $struct, "Pointer set");
>
> my $file = $struct->file;
> warn "FILE is $file\n";
> ok( $file eq '/etc/motd', "File OK");
>
> my $alpha = $struct->alpha;
> warn "alpha is " . sprintf("0x%x", $alpha) . "\n";
> ok( sprintf("%x", $alpha) eq '694c', "alpha OK");
>
> my $beta = $struct->beta;
> warn "beta is " . sprintf("0x%x", $beta) . "\n";
> ok( sprintf("%x", $beta) eq '756e', "beta OK");
>
> my $sigma = $struct->sigma;
> warn "sigma is " . sprintf("0x%x", $sigma) . "\n";
> ok( sprintf("%x", $sigma) eq 'deba', "sigma OK");
The successful output of running make clean is then :
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/ReadStruct.t .. 1/7 REF is ReadStruct FILE is /etc/motd alpha is 0x694c beta is 0x756e sigma is 0xdeba t/ReadStruct.t .. ok All tests successful. Files=1, Tests=7, 0 wallclock secs ( 0.04 usr 0.00 sys + 0.04 cusr 0.01 csys = 0.09 CPU) Result: PASSSource Code