A co-worker was adamant that I publish this after getting it running for our employer, and also sharing
the general details of how this works with a colleague of his who was in the same position that I was a few months ago. Although most of the gritty details falls in the C realm, this could be very beneficial to anyone who prefers developing quick solutions in Perl but may be currently locked into a C environment.
How to call Perl from within C/C++ code:
When researching this, I could not find a single source anywhere with ALL the information needed to write the code,
get it to compile, link, and run. Everything came in bits and pieces, so I've tossed it all together in one document
for those who might find it useful. Yes, much of the code and comments dealing with the stack setup and teardown
in C was taken from other sites and I take no credit for those.
Technical problem/solution:
My employer has a myriad of apps written in both C, Pro*C, and Perl. Due to some new regulatory requirements,
we needed to start encrypting entire incoming files that are received and validated one line at a time from both
our devices and third party clients. The timeframes that many of these calls operated in made it
useful to be able to validate the availability of service at any point in time, otherwise we could waste 30 seconds
of data transfer with our client, only to realize "oops we're down try again later" and not be able to complete the file I/O.
Rather than write encryption library clients in multiple languages, we found it quicker to just have C apps call
a Perl module that does the interfacing. All of the interfaces were very basic, all input parameters being simple
variables, no complex structs or objects being sent back and forth.
This example doesn't begin to touch what is available and supported. For more information, look up "perlcall"
information in your Perl API or on dozens of websites out there.
In this example, we're developing on RHEL4 with Perl 5.8.8 and gcc (GCC) 3.4.6 20060404.
This guide assumes you're already familiar with development in C, Perl, makefiles, and static vs. dynamic library linking.
The C side:
#include <EXTERN.h> /* from the Perl distribution */
#include <perl.h> /* from the Perl distribution */
static PerlInterpreter *my_perl = NULL; // The master object
EXTERN_C void xs_init (pTHX);
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); // Standard required
+declaration for runtime bootstrap loading
#ifndef RETURN_SUCCESS
#define RETURN_SUCCESS 0
#define RETURN_FAILURE 1
#endif
/*
* xs_init - Behind the scenes stuff so that Perl can dynamically l
+oad modules it needs
* Don't touch unless you know what you're doing
*/
EXTERN_C void xs_init(pTHX)
{
char *file = __FILE__;
dXSUB_SYS;
/* DynaLoader is a special case */
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
// Other declarations can be put here, again if you know what you'
+re doing
}
/*
* perl_env_check_service - Returns service availability status
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_check_service ( )
{
int return_val = RETURN_SUCCESS;
int count = 0;
return_val = perl_env_init();
if (return_val == RETURN_SUCCESS) {
SV * sva;
STRLEN len;
/* Standard macro calls required to manipulate the Perl stack to g
+et data to & from */
dSP; /* initialize stack pointer
+ */
ENTER; /* everything created after he
+re */
SAVETMPS; /* ...is a temporary variable.
+ */
PUSHMARK(SP); /* remember the stack pointer
+ */
PUTBACK; /* make local stack pointer glob
+al */
/* Make the call to Perl using one of four functions available (ca
+ll_sv, call_pv, call_method, and call_argv) */
count = call_pv("perl_env_check_service", G_SCALAR);
/* G_SCALAR says I want to check the return value and it should be
+ a scalar, many other options are available */
SPAGAIN; /* refresh stack pointer
+ */
if (count != 1) {
return_val = RETURN_FAILURE;
} else {
// Return value from this call is also just a success or failu
+re indicator
return_val = POPi;
}
FREETMPS; /* free that return value
+ */
LEAVE; /* ...and the XPUSHed "mortal" ar
+gs.*/
}
return return_val;
}
/*
* perl_env_init - Initializes the PCI (Perl) environment
* All interface methods will call this to ensure PCI environ
+ment is initialized
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_init() {
int return_val = RETURN_SUCCESS;
// Only run the Perl environment setup once
if (my_perl == NULL) {
// No need to pass any main() params for this example
return_val = perl_env_start(0, NULL, (char **)NULL);
}
return return_val;
}
/*
* perl_env_start - Starts up the environment
* @in my_string unused, just to pass in the required p
+arams
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_start(int argc, char **argv, char **env) {
int return_val = RETURN_SUCCESS;
// This is the Perl module we're calling
char *my_argv[] = { "", "/project/c_to_perl/bin/perl_env_file.
+pl" };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
if (my_perl == NULL) {
return_val = RETURN_FAILURE;
}
perl_construct(my_perl);
perl_parse(my_perl, xs_init, 2, my_argv, env);
return return_val;
}
/*
* perl_env_end - Cleanup. Needs to be called by users for proper c
+leanup.
*/
void perl_env_end() {
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
/*
* perl_env_file_read_line - Returns the next line from the file con
+tents
* @out my_string Will contain the next line contents of
+ the current file
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_file_read_line ( char* my_string )
{
int return_val = RETURN_SUCCESS;
int count = 0;
return_val = perl_env_init();
if (return_val == RETURN_SUCCESS) {
SV * sva; // Scalar value object, there is also Array Value
+ and Hash Value available (AV & HV)
STRLEN len;
dSP; /* initialize stack pointer
+ */
ENTER; /* everything created after he
+re */
SAVETMPS; /* ...is a temporary variable.
+ */
PUSHMARK(SP); /* remember the stack pointer
+ */
PUTBACK; /* make local stack pointer glob
+al */
count = call_pv("perl_env_file_read_line", G_SCALAR); /*
+call the function */
SPAGAIN; /* refresh stack pointer
+ */
if (count != 1) {
return_val = RETURN_FAILURE;
} else {
sva = POPs; // Pop the return var off the stack, ex
+pected to be a string
if (sva) {
strcpy(my_string, SvPV(sva, len));
}
PUTBACK;
}
FREETMPS; /* free that return value
+ */
LEAVE; /* ...and the XPUSHed "mortal" ar
+gs.*/
}
return return_val;
}
/*
* perl_env_file_open - Opens a PCI file for reading
* @in filename Filename to open
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_file_open ( char* filename )
{
int return_val = RETURN_SUCCESS;
int count = 0;
return_val = perl_env_init();
if (return_val == RETURN_SUCCESS) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
// Push the input var onto the stack
XPUSHs(sv_2mortal(newSVpv(filename, 0)));
PUTBACK;
count = call_pv("perl_env_file_open", G_SCALAR);
SPAGAIN;
if (count != 1) {
return_val = RETURN_FAILURE;
} else {
// Return value from this call is also just a success or failu
+re indicator
return_val = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
return return_val;
}
/*
* perl_env_file_write - Write the input string to the current data
+buffer
* @in my_string Data to store in output file
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_file_write ( const char* my_string )
{
int return_val = RETURN_SUCCESS;
int count = 0;
return_val = perl_env_init();
if (return_val == RETURN_SUCCESS) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
// Push the input var onto the stack
XPUSHs(sv_2mortal(newSVpv(my_string, 0)));
PUTBACK;
count = call_pv("perl_env_file_write", G_SCALAR);
SPAGAIN;
if (count != 1) {
return_val = RETURN_FAILURE;
} else {
// Return value from this call is also just a success or failu
+re indicator
return_val = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
return return_val;
}
/*
* perl_env_file_close - Close the current data contents and write t
+o specified filename
* @in filename Filename to write output to
* @out return_val RETURN_SUCCESS or RETURN_FAILURE
*/
int perl_env_file_close ( char* filename )
{
int return_val = RETURN_SUCCESS;
int count = 0;
return_val = perl_env_init();
if (return_val == RETURN_SUCCESS) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
// Push the input var onto the stack
XPUSHs(sv_2mortal(newSVpv(filename, 0)));
PUTBACK;
count = call_pv("perl_env_file_close", G_SCALAR);
SPAGAIN;
if (count != 1) {
return_val = RETURN_FAILURE;
} else {
return_val = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
return return_val;
}
/*
* Examples: (evaluating return values are ignored for simplicity)
*
* Writing a file
*
* char mybuf[LARGE_BUFFER_SIZE] = {0};
* if (perl_env_check_service() == RETURN_SUCCESS) { // Will
+initialize and startup
* while (read_from_some_data_source(mybuf) == RETURN_SUCCESS) {
* perl_env_file_write(mybuf);
* }
* perl_env_file_close("/project/tmp/myfile.txt");
* perl_env_end();
* }
*
*
* Reading a file
*
* char mybuf[LARGE_BUFFER_SIZE] = {0};
* int i=0;
* if (perl_env_check_service() == RETURN_SUCCESS) {
* perl_env_file_open("/project/tmp/myfile.txt");
* perl_env_file_read_line(mybuf);
* while (strlen(mybuf) > 0) {
* i++;
* printf("Line %d is >%s< \n", i, mybuf);
* perl_env_file_read_line(mybuf);
* }
* printf("All done reading file\n");
* // do NOT call close, that's for output files only
* perl_env_end();
* }
*/
These functions were a few of what were compiled into a static library, not the final application.
To compile and link, the following were necessary in our makefile:
includes: path to perl.h
CINCLUDES=-I/usr/lib/perl5/5.8.8/i686-linux-thread-multi-ld/CORE
linking: path to libperl.so or libperl.a and standard Perl lib
+rary linking statement
LOADLIBES=-L/usr/lib/perl5/5.8.8/i686-linux-thread-multi-ld/CORE
STD_LIBS= -lperl
libperl.so(a) may need to be built and added to your distribution. It is rather large, so
we preferred using dynamic linking here. otherwise the apps went from 50k to 1meg+.
The final application requires linking to the compiled library, let's say we named it libperlenv.a
LOADLIBES=-L/project/c_to_perl/lib/ This is where libperlenv.a
+resides
LDLIBS= -lperlenv `perl -MExtUtils::Embed -e ccopts -e ldopts`
This was the part I spent a couple days fighting after I thought I had it all nailed down. The loading of libperl.so(a)
is very picky about having the environment of your app match how Perl was compiled on the system.
The backticks in the makefile allowed this to compile and run on systems that slightly differ, because
we all know that development, testing, and production environments are ALL EXACTLY THE SAME, right? LOL
The Perl side:
/project/c_to_perl/bin/perl_env_file.pl - The same file we referenced in perl_env_start()
use MySpecialLib::IO; # Our IO library that reads/writes encrypted
+data to the filesystem
use constant RETURN_SUCCESS => 0;
use constant RETURN_FAILURE => 1;
# All global variables and arrays maintain their state throughout the
+life of the PerlInterpreter object in the C code
# Very cool and what allows this solution to work
my $data_out = '';
my @data_in_array = ();
my $fh_in = undef;
my $fh_out = undef;
# Each subroutine name matches one that the C code calls
#
# Attempts to instantiate a file object to see if service is available
#
sub perl_env_check_service {
my $ret_val = RETURN_SUCCESS;
if (MySpecialLib::IO->test() == 0) {
$ret_val = RETURN_FAILURE;
}
return $ret_val;
}
#
# Takes the incoming data stream and appends it to the data_out buffe
+r
#
sub perl_env_file_write {
my $data_str = shift;
$data_out .= $data_str;
return RETURN_SUCCESS;
}
#
# Writes the ongoing data_out contents to the filename specified and
+closes it
#
sub perl_env_file_close {
my $filename = shift;
eval {
$fh_out = MySpecialLib::IO->new('>', $filename, 'Writi
+ng file');
if (not defined($fh_out)) {
return RETURN_FAILURE;
}
$fh_out->print($data_out);
$fh_out->close();
};
if ($@) {
return RETURN_FAILURE;
}
$data_out = "";
return RETURN_SUCCESS;
}
#
# Opens the file specified
#
sub perl_env_file_open {
my $filename = shift;
eval
{
my $fh_in = MySpecialLib::IO->open('<', $filename, 'Reading
+ file $filename');
*FIN = *$fh_in;
@data_in_array = <FIN>;
$fh_in->close();
};
if ($@)
{
return RETURN_FAILURE;
}
return RETURN_SUCCESS;
}
#
# Returns the next line of the data_in contents
#
sub perl_env_file_read_line {
my $out_buffer = shift @data_in_array;
return $out_buffer;
}