Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

RFC: Calling Perl from C

by jhughe90 (Novice)
on Mar 24, 2010 at 20:17 UTC ( #830663=perlmeditation: print w/ replies, xml ) Need Help??

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; }

Comment on RFC: Calling Perl from C
Select or Download Code
Re: RFC: Calling Perl from C
by TGI (Vicar) on Mar 24, 2010 at 21:23 UTC

    This looks good after a quick skim. I still have to do a thorough reread.

    However, for the love of Mike, please add readmore tags around the code!


    TGI says moo

Re: RFC: Calling Perl from C
by dk (Chaplain) on Mar 26, 2010 at 13:49 UTC
    I'm sure you've read "perldoc perlembed", but if you say it doesn't contain ALL needed information, maybe you should also consider sending patches to it?
      I don't think I've ever seen ANY perldoc that covered all the obscurities necessary to get a solution working from beginning to end, especially compiling and linking in specific environments as was the major hurdle in this example.
Re: RFC: Calling Perl from C
by pid (Monk) on Mar 29, 2010 at 05:33 UTC

    I guess on intel Mac, you might want to take care of this line:

    LDLIBS= -lperlenv `perl -MExtUtils::Embed -e ccopts -e ldopts`

    Because it might contain the architecture that you don't want, ppc for example, while your library is built for i386/x86_64.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://830663]
Approved by Corion
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2014-09-22 03:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (177 votes), past polls