L<Compiling your C program>
-There's one example in each of the eight sections:
+There's one example in each of the nine sections:
L<Adding a Perl interpreter to your C program>
L<Using Perl modules, which themselves use C libraries, from your C program>
-This documentation is Unix specific; if you have information about how
-to embed Perl on other platforms, please send e-mail to <F<orwant@tpj.com>>.
+L<Embedding Perl under Win32>
=head2 Compiling your C program
=head2 Performing Perl pattern matches and substitutions from your C program
-The I<perl_eval_pv()> function lets us evaluate strings of Perl code, so we can
+The I<perl_eval_sv()> function lets us evaluate chunks of Perl code, so we can
define some functions that use it to "specialize" in matches and
substitutions: I<match()>, I<substitute()>, and I<matches()>.
- char match(char *string, char *pattern);
+ char match(SV *string, char *pattern);
Given a string and a pattern (e.g., C<m/clasp/> or C</\b\w*\b/>, which
in your C program might appear as "/\\b\\w*\\b/"), match()
returns 1 if the string matches the pattern and 0 otherwise.
- int substitute(char *string[], char *pattern);
+ int substitute(SV **string, char *pattern);
-Given a pointer to a string and an C<=~> operation (e.g.,
+Given a pointer to an C<SV> and an C<=~> operation (e.g.,
C<s/bob/robert/g> or C<tr[A-Z][a-z]>), substitute() modifies the string
-according to the operation, returning the number of substitutions
+within the C<AV> at according to the operation, returning the number of substitutions
made.
- int matches(char *string, char *pattern, char **matches[]);
+ int matches(SV *string, char *pattern, AV **matches);
-Given a string, a pattern, and a pointer to an empty array of strings,
+Given an C<SV>, a pattern, and a pointer to an empty C<AV>,
matches() evaluates C<$string =~ $pattern> in an array context, and
-fills in I<matches> with the array elements (allocating memory as it
-does so), returning the number of matches found.
+fills in I<matches> with the array elements, returning the number of matches found.
Here's a sample program, I<match.c>, that uses all three (long lines have
been wrapped here):
- #include <EXTERN.h>
- #include <perl.h>
-
- static PerlInterpreter *my_perl;
-
- /** match(string, pattern)
- **
- ** Used for matches in a scalar context.
- **
- ** Returns 1 if the match was successful; 0 otherwise.
- **/
- char match(char *string, char *pattern)
- {
- char *command;
- command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 37);
- sprintf(command, "$string = '%s'; $return = $string =~ %s",
- string, pattern);
- perl_eval_pv(command, TRUE);
- free(command);
- return SvIV(perl_get_sv("return", FALSE));
- }
- /** substitute(string, pattern)
- **
- ** Used for =~ operations that modify their left-hand side (s/// and tr///)
- **
- ** Returns the number of successful matches, and
- ** modifies the input string if there were any.
- **/
- int substitute(char *string[], char *pattern)
- {
- char *command;
- STRLEN length;
- command = malloc(sizeof(char) * strlen(*string) + strlen(pattern) + 35);
- sprintf(command, "$string = '%s'; $ret = ($string =~ %s)",
- *string, pattern);
- perl_eval_pv(command, TRUE);
- free(command);
- *string = SvPV(perl_get_sv("string", FALSE), length);
- return SvIV(perl_get_sv("ret", FALSE));
- }
- /** matches(string, pattern, matches)
- **
- ** Used for matches in an array context.
- **
- ** Returns the number of matches,
- ** and fills in **matches with the matching substrings (allocates memory!)
- **/
- int matches(char *string, char *pattern, char **match_list[])
- {
- char *command;
- SV *current_match;
- AV *array;
+ #include <EXTERN.h>
+ #include <perl.h>
+
+ /** my_perl_eval_sv(code, error_check)
+ ** kinda like perl_eval_sv(),
+ ** but we pop the return value off the stack
+ **/
+ SV* my_perl_eval_sv(SV *sv, I32 croak_on_error)
+ {
+ dSP;
+ SV* retval;
+
+ PUSHMARK(SP);
+ perl_eval_sv(sv, G_SCALAR);
+
+ SPAGAIN;
+ retval = POPs;
+ PUTBACK;
+
+ if (croak_on_error && SvTRUE(GvSV(errgv)))
+ croak(SvPVx(GvSV(errgv), na));
+
+ return retval;
+ }
+
+ /** match(string, pattern)
+ **
+ ** Used for matches in a scalar context.
+ **
+ ** Returns 1 if the match was successful; 0 otherwise.
+ **/
+
+ I32 match(SV *string, char *pattern)
+ {
+ SV *command = NEWSV(1099, 0), *retval;
+
+ sv_setpvf(command, "my $string = '%s'; $string =~ %s",
+ SvPV(string,na), pattern);
+
+ retval = my_perl_eval_sv(command, TRUE);
+ SvREFCNT_dec(command);
+
+ return SvIV(retval);
+ }
+
+ /** substitute(string, pattern)
+ **
+ ** Used for =~ operations that modify their left-hand side (s/// and tr///)
+ **
+ ** Returns the number of successful matches, and
+ ** modifies the input string if there were any.
+ **/
+
+ I32 substitute(SV **string, char *pattern)
+ {
+ SV *command = NEWSV(1099, 0), *retval;
+
+ sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
+ SvPV(*string,na), pattern);
+
+ retval = my_perl_eval_sv(command, TRUE);
+ SvREFCNT_dec(command);
+
+ *string = perl_get_sv("string", FALSE);
+ return SvIV(retval);
+ }
+
+ /** matches(string, pattern, matches)
+ **
+ ** Used for matches in an array context.
+ **
+ ** Returns the number of matches,
+ ** and fills in **matches with the matching substrings
+ **/
+
+ I32 matches(SV *string, char *pattern, AV **match_list)
+ {
+ SV *command = NEWSV(1099, 0);
I32 num_matches;
- STRLEN length;
- int i;
- command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 38);
- sprintf(command, "$string = '%s'; @array = ($string =~ %s)",
- string, pattern);
- perl_eval_pv(command, TRUE);
- free(command);
- array = perl_get_av("array", FALSE);
- num_matches = av_len(array) + 1; /** assume $[ is 0 **/
- *match_list = (char **) malloc(sizeof(char *) * num_matches);
- for (i = 0; i <= num_matches; i++) {
- current_match = av_shift(array);
- (*match_list)[i] = SvPV(current_match, length);
- }
+
+ sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
+ SvPV(string,na), pattern);
+
+ my_perl_eval_sv(command, TRUE);
+ SvREFCNT_dec(command);
+
+ *match_list = perl_get_av("array", FALSE);
+ num_matches = av_len(*match_list) + 1; /** assume $[ is 0 **/
+
return num_matches;
- }
- main (int argc, char **argv, char **env)
- {
+ }
+
+ main (int argc, char **argv, char **env)
+ {
+ PerlInterpreter *my_perl = perl_alloc();
char *embedding[] = { "", "-e", "0" };
- char *text, **match_list;
- int num_matches, i;
- int j;
- my_perl = perl_alloc();
- perl_construct( my_perl );
+ AV *match_list;
+ I32 num_matches, i;
+ SV *text = NEWSV(1099,0);
+
+ perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
- perl_run(my_perl);
-
- text = (char *) malloc(sizeof(char) * 486); /** A long string follows! **/
- sprintf(text, "%s", "When he is at a convenience store and the bill \
- comes to some amount like 76 cents, Maynard is aware that there is \
- something he *should* do, something that will enable him to get back \
- a quarter, but he has no idea *what*. He fumbles through his red \
- squeezey changepurse and gives the boy three extra pennies with his \
- dollar, hoping that he might luck into the correct amount. The boy \
- gives him back two of his own pennies and then the big shiny quarter \
- that is his prize. -RICHH");
+
+ sv_setpv(text, "When he is at a convenience store and the bill comes to some amount like 76 cents, Maynard is aware that there is something he *should* do, something that will enable him to get back a quarter, but he has no idea *what*. He fumbles through his red squeezey changepurse and gives the boy three extra pennies with his dollar, hoping that he might luck into the correct amount. The boy gives him back two of his own pennies and then the big shiny quarter that is his prize. -RICHH");
+
if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/
- printf("match: Text contains the word 'quarter'.\n\n");
+ printf("match: Text contains the word 'quarter'.\n\n");
else
- printf("match: Text doesn't contain the word 'quarter'.\n\n");
+ printf("match: Text doesn't contain the word 'quarter'.\n\n");
+
if (match(text, "m/eighth/")) /** Does text contain 'eighth'? **/
- printf("match: Text contains the word 'eighth'.\n\n");
+ printf("match: Text contains the word 'eighth'.\n\n");
else
- printf("match: Text doesn't contain the word 'eighth'.\n\n");
+ printf("match: Text doesn't contain the word 'eighth'.\n\n");
+
/** Match all occurrences of /wi../ **/
num_matches = matches(text, "m/(wi..)/g", &match_list);
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
+
for (i = 0; i < num_matches; i++)
- printf("match: %s\n", match_list[i]);
+ printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),na));
printf("\n");
- for (i = 0; i < num_matches; i++) {
- free(match_list[i]);
- }
- free(match_list);
+
/** Remove all vowels from text **/
num_matches = substitute(&text, "s/[aeiou]//gi");
if (num_matches) {
- printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
- num_matches);
- printf("Now text is: %s\n\n", text);
+ printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
+ num_matches);
+ printf("Now text is: %s\n\n", SvPV(text,na));
}
+
/** Attempt a substitution **/
if (!substitute(&text, "s/Perl/C/")) {
- printf("substitute: s/Perl/C...No substitution made.\n\n");
+ printf("substitute: s/Perl/C...No substitution made.\n\n");
}
- free(text);
+
+ SvREFCNT_dec(text);
+ perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
- }
+ }
which produces the output (again, long lines have been wrapped here)
dSP; /* initialize stack pointer */
ENTER; /* everything created after here */
SAVETMPS; /* ...is a temporary variable. */
- PUSHMARK(sp); /* remember the stack pointer */
+ PUSHMARK(SP); /* remember the stack pointer */
XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack */
XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack */
PUTBACK; /* make local stack pointer global */
int main (int argc, char **argv, char **env)
{
- char *my_argv[2];
+ char *my_argv[] = { "", "power.pl" };
my_perl = perl_alloc();
perl_construct( my_perl );
- my_argv[1] = (char *) malloc(10);
- sprintf(my_argv[1], "power.pl");
-
- perl_parse(my_perl, NULL, argc, my_argv, NULL);
+ perl_parse(my_perl, NULL, 2, my_argv, (char **)NULL);
perl_run(my_perl);
PerlPower(3, 4); /*** Compute 3 ** 4 ***/
Consult L<perlxs> and L<perlguts> for more details.
+=head1 Embedding Perl under Win32
+
+At the time of this writing, there are two versions of Perl which run
+under Win32. Interfacing to Activeware's Perl library is quite
+different from the examples in this documentation, as significant
+changes were made to the internal Perl API. However, it is possible
+to embed Activeware's Perl runtime, see the Perl for Win32 FAQ:
+http://www.perl.com/perl/faq/win32/Perl_for_Win32_FAQ.html
+
+With the "official" Perl version 5.004 or higher, all the examples
+within this documentation will compile and run untouched, although,
+the build process is slightly different between Unix and Win32.
+
+For starters, backticks don't work under the Win32 native command shell!
+The ExtUtils::Embed kit on CPAN ships with a script called
+B<genmake>, which generates a simple makefile to build a program from
+a single C source file. It can be used like so:
+
+ C:\ExtUtils-Embed\eg> perl genmake interp.c
+ C:\ExtUtils-Embed\eg> nmake
+ C:\ExtUtils-Embed\eg> interp -e "print qq{I'm embedded in Win32!\n}"
+
+You may wish to use a more robust environment such as the MS Developer
+stdio. In this case, to generate perlxsi.c run:
+
+ perl -MExtUtils::Embed -e xsinit
+
+Create a new project, Insert -> Files into Project: perlxsi.c, perl.lib,
+and your own source files, e.g. interp.c. Typically you'll find
+perl.lib in B<C:\perl\lib\CORE>, if not, you should see the B<CORE>
+directory relative to C<perl -V:archlib>.
+The studio will also need this path so it knows where to find Perl
+include files. This path can be added via the Tools -> Options ->
+Directories menu. Finnally, select Build -> Build interp.exe and
+you're ready to go!
=head1 MORAL
Check out Doug's article on embedding in Volume 1, Issue 4 of The Perl
Journal. Info about TPJ is available from http://tpj.com.
-April 14, 1997
+July 17, 1997
Some of this material is excerpted from Jon Orwant's book: I<Perl 5
Interactive>, Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears
projects / p5sagit/p5-mst-13.2.git / blobdiff