pod/perlembed.pod

   1 =head1 NAME
   2
   3 perlembed - how to embed perl in your C program
   4
   5 =head1 DESCRIPTION
   6
   7 =head2 PREAMBLE
   8
   9 Do you want to:
  10
  11 =over 5
  12
  13 =item B<Use C from Perl?>
  14
  15 Read L<perlcall> and L<perlxs>.
  16
  17 =item B<Use a UNIX program from Perl?>
  18
  19 Read about back-quotes and about C<system> and C<exec> in L<perlfunc>.
  20
  21 =item B<Use Perl from Perl?>
  22
  23 Read about C<do> and C<eval> in L<perlfunc/do> and L<perlfunc/eval> and C<use>
  24 and C<require> in L<perlmod> and L<perlfunc/require>, L<perlfunc/use>.
  25
  26 =item B<Use C from C?>
  27
  28 Rethink your design.
  29
  30 =item B<Use Perl from C?>
  31
  32 Read on...
  33
  34 =back
  35
  36 =head2 ROADMAP
  37
  38 L<Compiling your C program>
  39
  40 There's one example in each of the eight sections:
  41
  42 L<Adding a Perl interpreter to your C program>
  43
  44 L<Calling a Perl subroutine from your C program>
  45
  46 L<Evaluating a Perl statement from your C program>
  47
  48 L<Performing Perl pattern matches and substitutions from your C program>
  49
  50 L<Fiddling with the Perl stack from your C program>
  51
  52 L<Maintaining a persistent interpreter>
  53
  54 L<Maintaining multiple interpreter instances>
  55
  56 L<Using Perl modules, which themselves use C libraries, from your C program>
  57
  58 This documentation is UNIX specific.
  59
  60 =head2 Compiling your C program
  61
  62 Every C program that uses Perl must link in the I<perl library>.
  63
  64 What's that, you ask?  Perl is itself written in C; the perl library
  65 is the collection of compiled C programs that were used to create your
  66 perl executable (I</usr/bin/perl> or equivalent).  (Corollary: you
  67 can't use Perl from your C program unless Perl has been compiled on
  68 your machine, or installed properly--that's why you shouldn't blithely
  69 copy Perl executables from machine to machine without also copying the
  70 I<lib> directory.)
  71
  72 Your C program will--usually--allocate, "run", and deallocate a
  73 I<PerlInterpreter> object, which is defined in the perl library.
  74
  75 If your copy of Perl is recent enough to contain this documentation
  76 (version 5.002 or later), then the perl library (and I<EXTERN.h> and
  77 I<perl.h>, which you'll also need) will
  78 reside in a directory resembling this:
  79
  80     /usr/local/lib/perl5/your_architecture_here/CORE
  81
  82 or perhaps just
  83
  84     /usr/local/lib/perl5/CORE
  85
  86 or maybe something like
  87
  88     /usr/opt/perl5/CORE
  89
  90 Execute this statement for a hint about where to find CORE:
  91
  92     perl -MConfig -e 'print $Config{archlib}'
  93
  94 Here's how you might compile the example in the next section,
  95 L<Adding a Perl interpreter to your C program>,
  96 on a DEC Alpha running the OSF operating system:
  97
  98     % cc -o interp interp.c -L/usr/local/lib/perl5/alpha-dec_osf/CORE
  99     -I/usr/local/lib/perl5/alpha-dec_osf/CORE -lperl -lm
 100
 101 You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.)  and
 102 library directory (I</usr/local/lib/...>)  for your machine.  If your
 103 compiler complains that certain functions are undefined, or that it
 104 can't locate I<-lperl>, then you need to change the path following the
 105 -L.  If it complains that it can't find I<EXTERN.h> or I<perl.h>, you need
 106 to change the path following the -I.
 107
 108 You may have to add extra libraries as well.  Which ones?
 109 Perhaps those printed by
 110
 111    perl -MConfig -e 'print $Config{libs}'
 112
 113 We strongly recommend you use the B<ExtUtils::Embed> module to determine
 114 all of this information for you:
 115
 116    % cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
 117
 118
 119 If the B<ExtUtils::Embed> module is not part of your perl kit's
 120 distribution you can retrieve it from:
 121 http://www.perl.com/cgi-bin/cpan_mod?module=ExtUtils::Embed.
 122
 123
 124 =head2 Adding a Perl interpreter to your C program
 125
 126 In a sense, perl (the C program) is a good example of embedding Perl
 127 (the language), so I'll demonstrate embedding with I<miniperlmain.c>,
 128 from the source distribution.  Here's a bastardized, non-portable version of
 129 I<miniperlmain.c> containing the essentials of embedding:
 130
 131     #include <EXTERN.h>               /* from the Perl distribution     */
 132     #include <perl.h>                 /* from the Perl distribution     */
 133
 134     static PerlInterpreter *my_perl;  /***    The Perl interpreter    ***/
 135
 136     int main(int argc, char **argv, char **env)
 137     {
 138         my_perl = perl_alloc();
 139         perl_construct(my_perl);
 140         perl_parse(my_perl, NULL, argc, argv, (char **)NULL);
 141         perl_run(my_perl);
 142         perl_destruct(my_perl);
 143         perl_free(my_perl);
 144     }
 145
 146 Note that we do not use the C<env> pointer here or in any of the
 147 following examples.
 148 Normally handed to C<perl_parse> as its final argument,
 149 we hand it a B<NULL> instead, in which case the current environment
 150 is used.
 151
 152 Now compile this program (I'll call it I<interp.c>) into an executable:
 153
 154     % cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
 155
 156 After a successful compilation, you'll be able to use I<interp> just
 157 like perl itself:
 158
 159     % interp
 160     print "Pretty Good Perl \n";
 161     print "10890 - 9801 is ", 10890 - 9801;
 162     <CTRL-D>
 163     Pretty Good Perl
 164     10890 - 9801 is 1089
 165
 166 or
 167
 168     % interp -e 'printf("%x", 3735928559)'
 169     deadbeef
 170
 171 You can also read and execute Perl statements from a file while in the
 172 midst of your C program, by placing the filename in I<argv[1]> before
 173 calling I<perl_run()>.
 174
 175 =head2 Calling a Perl subroutine from your C program
 176
 177 To call individual Perl subroutines, you can use any of the B<perl_call_*>
 178 functions documented in the L<perlcall> man page.
 179 In this example we'll use I<perl_call_argv>.
 180
 181 That's shown below, in a program I'll call I<showtime.c>.
 182
 183     #include <EXTERN.h>
 184     #include <perl.h>
 185
 186     static PerlInterpreter *my_perl;
 187
 188     int main(int argc, char **argv, char **env)
 189     {
 190         char *args[] = { NULL };
 191         my_perl = perl_alloc();
 192         perl_construct(my_perl);
 193
 194         perl_parse(my_perl, NULL, argc, argv, NULL);
 195
 196         /*** skipping perl_run() ***/
 197
 198         perl_call_argv("showtime", G_DISCARD | G_NOARGS, args);
 199
 200         perl_destruct(my_perl);
 201         perl_free(my_perl);
 202     }
 203
 204 where I<showtime> is a Perl subroutine that takes no arguments (that's the
 205 I<G_NOARGS>) and for which I'll ignore the return value (that's the
 206 I<G_DISCARD>).  Those flags, and others, are discussed in L<perlcall>.
 207
 208 I'll define the I<showtime> subroutine in a file called I<showtime.pl>:
 209
 210     print "I shan't be printed.";
 211
 212     sub showtime {
 213         print time;
 214     }
 215
 216 Simple enough.  Now compile and run:
 217
 218     % cc -o showtime showtime.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
 219
 220     % showtime showtime.pl
 221     818284590
 222
 223 yielding the number of seconds that elapsed between January 1, 1970
 224 (the beginning of the UNIX epoch), and the moment I began writing this
 225 sentence.
 226
 227 Note that in this particular case we are not required to call I<perl_run>,
 228 however, in general it's considered good practice to ensure proper
 229 initialization of library code including execution of all object C<DESTROY>
 230 methods and package C<END {}> blocks.
 231
 232 If you want to pass some arguments to the Perl subroutine, you may add
 233 strings to the C<NULL> terminated C<args> list passed to I<perl_call_argv>.
 234 In order to pass arguments of another data type and/or examine return values
 235 of the subroutine you'll need to manipulate the
 236 Perl stack, demonstrated in the last section of this document:
 237 L<Fiddling with the Perl stack from your C program>
 238
 239 =head2 Evaluating a Perl statement from your C program
 240
 241 One way to evaluate pieces of Perl code is to use L<perlguts/perl_eval_sv>.
 242 We have wrapped this function with our own I<perl_eval()> function, which
 243 converts a command string to an SV, passing this and the L<perlcall/G_DISCARD>
 244 flag to L<perlguts/perl_eval_sv>.
 245
 246 Arguably, this is the only routine you'll ever need to execute
 247 snippets of Perl code from within your C program.  Your string can be
 248 as long as you wish; it can contain multiple statements; it can
 249 include L<perlfunc/use>, L<perlfunc/require> and L<perlfunc/do> to
 250 include external Perl files.
 251
 252 Our I<perl_eval()> lets us evaluate individual Perl strings, and then
 253 extract variables for coercion into C types.  The following program,
 254 I<string.c>, executes three Perl strings, extracting an C<int> from
 255 the first, a C<float> from the second, and a C<char *> from the third.
 256
 257    #include <EXTERN.h>
 258    #include <perl.h>
 259
 260    static PerlInterpreter *my_perl;
 261
 262    I32 perl_eval(char *string)
 263    {
 264      return perl_eval_sv(newSVpv(string,0), G_DISCARD);
 265    }
 266
 267    main (int argc, char **argv, char **env)
 268    {
 269      char *embedding[] = { "", "-e", "0" };
 270      STRLEN length;
 271
 272      my_perl = perl_alloc();
 273      perl_construct( my_perl );
 274
 275      perl_parse(my_perl, NULL, 3, embedding, NULL);
 276      perl_run(my_perl);
 277                                        /** Treat $a as an integer **/
 278      perl_eval("$a = 3; $a **= 2");
 279      printf("a = %d\n", SvIV(perl_get_sv("a", FALSE)));
 280
 281                                        /** Treat $a as a float **/
 282      perl_eval("$a = 3.14; $a **= 2");
 283      printf("a = %f\n", SvNV(perl_get_sv("a", FALSE)));
 284
 285                                        /** Treat $a as a string **/
 286      perl_eval("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a); ");
 287      printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), length));
 288
 289      perl_destruct(my_perl);
 290      perl_free(my_perl);
 291    }
 292
 293 All of those strange functions with I<sv> in their names help convert Perl scalars to C types.  They're described in L<perlguts>.
 294
 295 If you compile and run I<string.c>, you'll see the results of using
 296 I<SvIV()> to create an C<int>, I<SvNV()> to create a C<float>, and
 297 I<SvPV()> to create a string:
 298
 299    a = 9
 300    a = 9.859600
 301    a = Just Another Perl Hacker
 302
 303
 304 =head2 Performing Perl pattern matches and substitutions from your C program
 305
 306 Our I<perl_eval()> lets us evaluate strings of Perl code, so we can
 307 define some functions that use it to "specialize" in matches and
 308 substitutions: I<match()>, I<substitute()>, and I<matches()>.
 309
 310    char match(char *string, char *pattern);
 311
 312 Given a string and a pattern (e.g., "m/clasp/" or "/\b\w*\b/", which in
 313 your program might be represented as C<"/\\b\\w*\\b/">),
 314 returns 1 if the string matches the pattern and 0 otherwise.
 315
 316
 317    int substitute(char *string[], char *pattern);
 318
 319 Given a pointer to a string and an "=~" operation (e.g., "s/bob/robert/g" or
 320 "tr[A-Z][a-z]"), modifies the string according to the operation,
 321 returning the number of substitutions made.
 322
 323    int matches(char *string, char *pattern, char **matches[]);
 324
 325 Given a string, a pattern, and a pointer to an empty array of strings,
 326 evaluates C<$string =~ $pattern> in an array context, and fills in
 327 I<matches> with the array elements (allocating memory as it does so),
 328 returning the number of matches found.
 329
 330 Here's a sample program, I<match.c>, that uses all three (long lines have
 331 been wrapped here):
 332
 333    #include <EXTERN.h>
 334    #include <perl.h>
 335    static PerlInterpreter *my_perl;
 336    I32 perl_eval(char *string)
 337    {
 338       return perl_eval_sv(newSVpv(string,0), G_DISCARD);
 339    }
 340    /** match(string, pattern)
 341    **
 342    ** Used for matches in a scalar context.
 343    **
 344    ** Returns 1 if the match was successful; 0 otherwise.
 345    **/
 346    char match(char *string, char *pattern)
 347    {
 348      char *command;
 349      command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 37);
 350      sprintf(command, "$string = '%s'; $return = $string =~ %s",
 351                       string, pattern);
 352      perl_eval(command);
 353      free(command);
 354      return SvIV(perl_get_sv("return", FALSE));
 355    }
 356    /** substitute(string, pattern)
 357    **
 358    ** Used for =~ operations that modify their left-hand side (s/// and tr///)
 359    **
 360    ** Returns the number of successful matches, and
 361    ** modifies the input string if there were any.
 362    **/
 363    int substitute(char *string[], char *pattern)
 364    {
 365      char *command;
 366      STRLEN length;
 367      command = malloc(sizeof(char) * strlen(*string) + strlen(pattern) + 35);
 368      sprintf(command, "$string = '%s'; $ret = ($string =~ %s)",
 369                       *string, pattern);
 370      perl_eval(command);
 371      free(command);
 372      *string = SvPV(perl_get_sv("string", FALSE), length);
 373      return SvIV(perl_get_sv("ret", FALSE));
 374    }
 375    /** matches(string, pattern, matches)
 376    **
 377    ** Used for matches in an array context.
 378    **
 379    ** Returns the number of matches,
 380    ** and fills in **matches with the matching substrings (allocates memory!)
 381    **/
 382    int matches(char *string, char *pattern, char **match_list[])
 383    {
 384      char *command;
 385      SV *current_match;
 386      AV *array;
 387      I32 num_matches;
 388      STRLEN length;
 389      int i;
 390      command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 38);
 391      sprintf(command, "$string = '%s'; @array = ($string =~ %s)",
 392                       string, pattern);
 393      perl_eval(command);
 394      free(command);
 395      array = perl_get_av("array", FALSE);
 396      num_matches = av_len(array) + 1; /** assume $[ is 0 **/
 397      *match_list = (char **) malloc(sizeof(char *) * num_matches);
 398      for (i = 0; i <= num_matches; i++) {
 399        current_match = av_shift(array);
 400        (*match_list)[i] = SvPV(current_match, length);
 401      }
 402      return num_matches;
 403    }
 404    main (int argc, char **argv, char **env)
 405    {
 406      char *embedding[] = { "", "-e", "0" };
 407      char *text, **match_list;
 408      int num_matches, i;
 409      int j;
 410      my_perl = perl_alloc();
 411      perl_construct( my_perl );
 412      perl_parse(my_perl, NULL, 3, embedding, NULL);
 413      perl_run(my_perl);
 414
 415      text = (char *) malloc(sizeof(char) * 486); /** A long string follows! **/
 416      sprintf(text, "%s", "When he is at a convenience store and the bill \
 417      comes to some amount like 76 cents, Maynard is aware that there is \
 418      something he *should* do, something that will enable him to get back \
 419      a quarter, but he has no idea *what*.  He fumbles through his red \
 420      squeezey changepurse and gives the boy three extra pennies with his \
 421      dollar, hoping that he might luck into the correct amount.  The boy \
 422      gives him back two of his own pennies and then the big shiny quarter \
 423      that is his prize. -RICHH");
 424      if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/
 425        printf("match: Text contains the word 'quarter'.\n\n");
 426      else
 427        printf("match: Text doesn't contain the word 'quarter'.\n\n");
 428      if (match(text, "m/eighth/")) /** Does text contain 'eighth'? **/
 429        printf("match: Text contains the word 'eighth'.\n\n");
 430      else
 431        printf("match: Text doesn't contain the word 'eighth'.\n\n");
 432      /** Match all occurrences of /wi../ **/
 433      num_matches = matches(text, "m/(wi..)/g", &match_list);
 434      printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
 435      for (i = 0; i < num_matches; i++)
 436        printf("match: %s\n", match_list[i]);
 437      printf("\n");
 438      for (i = 0; i < num_matches; i++) {
 439        free(match_list[i]);
 440      }
 441      free(match_list);
 442      /** Remove all vowels from text **/
 443      num_matches = substitute(&text, "s/[aeiou]//gi");
 444      if (num_matches) {
 445        printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
 446               num_matches);
 447        printf("Now text is: %s\n\n", text);
 448      }
 449      /** Attempt a substitution **/
 450      if (!substitute(&text, "s/Perl/C/")) {
 451        printf("substitute: s/Perl/C...No substitution made.\n\n");
 452      }
 453      free(text);
 454      perl_destruct(my_perl);
 455      perl_free(my_perl);
 456    }
 457
 458 which produces the output (again, long lines have been wrapped here)
 459
 460    perl_match: Text contains the word 'quarter'.
 461
 462    perl_match: Text doesn't contain the word 'eighth'.
 463
 464    perl_matches: m/(wi..)/g found 2 matches...
 465    match: will
 466    match: with
 467
 468    perl_substitute: s/[aeiou]//gi...139 substitutions made.
 469    Now text is: Whn h s t  cnvnnc str nd th bll cms t sm mnt lk 76 cnts,
 470    Mynrd s wr tht thr s smthng h *shld* d, smthng tht wll nbl hm t gt bck
 471    qrtr, bt h hs n d *wht*.  H fmbls thrgh hs rd sqzy chngprs nd gvs th by
 472    thr xtr pnns wth hs dllr, hpng tht h mght lck nt th crrct mnt.  Th by gvs
 473    hm bck tw f hs wn pnns nd thn th bg shny qrtr tht s hs prz. -RCHH
 474
 475    perl_substitute: s/Perl/C...No substitution made.
 476
 477 =head2 Fiddling with the Perl stack from your C program
 478
 479 When trying to explain stacks, most computer science textbooks mumble
 480 something about spring-loaded columns of cafeteria plates: the last
 481 thing you pushed on the stack is the first thing you pop off.  That'll
 482 do for our purposes: your C program will push some arguments onto "the Perl
 483 stack", shut its eyes while some magic happens, and then pop the
 484 results--the return value of your Perl subroutine--off the stack.
 485
 486 First you'll need to know how to convert between C types and Perl
 487 types, with newSViv() and sv_setnv() and newAV() and all their
 488 friends.  They're described in L<perlguts>.
 489
 490 Then you'll need to know how to manipulate the Perl stack.  That's
 491 described in L<perlcall>.
 492
 493 Once you've understood those, embedding Perl in C is easy.
 494
 495 Because C has no built-in function for integer exponentiation, let's
 496 make Perl's ** operator available to it (this is less useful than it
 497 sounds, because Perl implements ** with C's I<pow()> function).  First
 498 I'll create a stub exponentiation function in I<power.pl>:
 499
 500     sub expo {
 501         my ($a, $b) = @_;
 502         return $a ** $b;
 503     }
 504
 505 Now I'll create a C program, I<power.c>, with a function
 506 I<PerlPower()> that contains all the perlguts necessary to push the
 507 two arguments into I<expo()> and to pop the return value out.  Take a
 508 deep breath...
 509
 510     #include <EXTERN.h>
 511     #include <perl.h>
 512
 513     static PerlInterpreter *my_perl;
 514
 515     static void
 516     PerlPower(int a, int b)
 517     {
 518       dSP;                            /* initialize stack pointer      */
 519       ENTER;                          /* everything created after here */
 520       SAVETMPS;                       /* ...is a temporary variable.   */
 521       PUSHMARK(sp);                   /* remember the stack pointer    */
 522       XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack  */
 523       XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack  */
 524       PUTBACK;                      /* make local stack pointer global */
 525       perl_call_pv("expo", G_SCALAR); /* call the function             */
 526       SPAGAIN;                        /* refresh stack pointer         */
 527                                     /* pop the return value from stack */
 528       printf ("%d to the %dth power is %d.\n", a, b, POPi);
 529       PUTBACK;
 530       FREETMPS;                       /* free that return value        */
 531       LEAVE;                       /* ...and the XPUSHed "mortal" args.*/
 532     }
 533
 534     int main (int argc, char **argv, char **env)
 535     {
 536       char *my_argv[2];
 537
 538       my_perl = perl_alloc();
 539       perl_construct( my_perl );
 540
 541       my_argv[1] = (char *) malloc(10);
 542       sprintf(my_argv[1], "power.pl");
 543
 544       perl_parse(my_perl, NULL, argc, my_argv, NULL);
 545       perl_run(my_perl);
 546
 547       PerlPower(3, 4);                      /*** Compute 3 ** 4 ***/
 548
 549       perl_destruct(my_perl);
 550       perl_free(my_perl);
 551     }
 552
 553
 554
 555 Compile and run:
 556
 557     % cc -o power power.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
 558
 559     % power
 560     3 to the 4th power is 81.
 561
 562 =head2 Maintaining a persistent interpreter
 563
 564 When developing interactive, potentially long-running applications, it's
 565 a good idea to maintain a persistent interpreter rather than allocating
 566 and constructing a new interpreter multiple times.  The major gain here is
 567 speed, avoiding the penalty of Perl start-up time.  However, a persistent
 568 interpreter will require you to be more cautious in your use of namespace
 569 and variable scoping.  In previous examples we've been using global variables
 570 in the default package B<main>.  We knew exactly what code would be run,
 571 making it safe to assume we'd avoid any variable collision or outrageous
 572 symbol table growth.
 573
 574 Let's say your application is a server, which must run perl code from an
 575 arbitrary file during each transaction.  Your server has no way of knowing
 576 what code is inside anyone of these files.
 577 If the file was pulled in by B<perl_parse()>, compiled into a newly
 578 constructed interpreter, then cleaned out with B<perl_destruct()> after the
 579 the transaction, you'd be shielded from most namespace troubles.
 580
 581 One way to avoid namespace collisions in this scenerio, is to translate the
 582 file name into a valid Perl package name, which is most likely to be unique,
 583 then compile the code into that package using L<perlfunc/eval>.
 584 In the example below, each file will only be compiled once, unless it is
 585 updated on disk.
 586 Optionally, the application may choose to clean out the symbol table
 587 associated with the file after we are done with it.  We'll call the subroutine
 588 B<Embed::Persistent::eval_file> which lives in the file B<persistent.pl>, with
 589 L<perlcall/perl_call_argv>, passing the filename and boolean cleanup/cache
 590 flag as arguments.
 591
 592 Note that the process will continue to grow for each file that is compiled,
 593 and each file it pulls in via L<perlfunc/require>, L<perlfunc/use> or
 594 L<perlfunc/do>.  In addition, there maybe B<AUTOLOAD>ed subroutines and
 595 other conditions that cause Perl's symbol table to grow.  You may wish to
 596 add logic which keeps track of process size or restarts itself after n number
 597 of requests to ensure memory consumption is kept to a minimum.  You also need
 598 to consider the importance of variable scoping with L<perlfunc/my> to futher
 599 reduce symbol table growth.
 600
 601
 602  package Embed::Persistent;
 603  #persistent.pl
 604
 605  use strict;
 606  use vars '%Cache';
 607
 608  #use Devel::Symdump ();
 609
 610  sub valid_package_name {
 611      my($string) = @_;
 612      $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
 613      # second pass only for words starting with a digit
 614      $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
 615
 616      # Dress it up as a real package name
 617      $string =~ s|/|::|g;
 618      return "Embed" . $string;
 619  }
 620
 621  #borrowed from Safe.pm
 622  sub delete_package {
 623      my $pkg = shift;
 624      my ($stem, $leaf);
 625
 626      no strict 'refs';
 627      $pkg = "main::$pkg\::";    # expand to full symbol table name
 628      ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
 629
 630      my $stem_symtab = *{$stem}{HASH};
 631
 632      delete $stem_symtab->{$leaf};
 633  }
 634
 635  sub eval_file {
 636      my($filename, $delete) = @_;
 637      my $package = valid_package_name($filename);
 638      my $mtime = -M $filename;
 639      if(defined $Cache{$package}{mtime}
 640         &&
 641         $Cache{$package}{mtime} <= $mtime)
 642      {
 643         # we have compiled this subroutine already,
 644         # it has not been updated on disk, nothing left to do
 645         print STDERR "already compiled $package->handler\n";
 646      }
 647      else {
 648         local *FH;
 649         open FH, $filename or die "open '$filename' $!";
 650         local($/) = undef;
 651         my $sub = <FH>;
 652         close FH;
 653
 654         #wrap the code into a subroutine inside our unique package
 655         my $eval = qq{package $package; sub handler { $sub; }};
 656         {
 657             # hide our variables within this block
 658             my($filename,$mtime,$package,$sub);
 659             eval $eval;
 660         }
 661         die $@ if $@;
 662
 663         #cache it unless we're cleaning out each time
 664         $Cache{$package}{mtime} = $mtime unless $delete;
 665      }
 666
 667      eval {$package->handler;};
 668      die $@ if $@;
 669
 670      delete_package($package) if $delete;
 671
 672      #take a look if you want
 673      #print Devel::Symdump->rnew($package)->as_string, $/;
 674  }
 675
 676  1;
 677
 678  __END__
 679
 680  /* persistent.c */
 681  #include <EXTERN.h>
 682  #include <perl.h>
 683
 684  /* 1 = clean out filename's symbol table after each request, 0 = don't */
 685  #ifndef DO_CLEAN
 686  #define DO_CLEAN 0
 687  #endif
 688
 689  static PerlInterpreter *perl = NULL;
 690
 691  int
 692  main(int argc, char **argv, char **env)
 693  {
 694      char *embedding[] = { "", "persistent.pl" };
 695      char *args[] = { "", DO_CLEAN, NULL };
 696      char filename [1024];
 697      int exitstatus = 0;
 698
 699      if((perl = perl_alloc()) == NULL) {
 700         fprintf(stderr, "no memory!");
 701         exit(1);
 702      }
 703      perl_construct(perl);
 704
 705      exitstatus = perl_parse(perl, NULL, 2, embedding, NULL);
 706
 707      if(!exitstatus) {
 708         exitstatus = perl_run(perl);
 709
 710         while(printf("Enter file name: ") && gets(filename)) {
 711
 712             /* call the subroutine, passing it the filename as an argument */
 713             args[0] = filename;
 714             perl_call_argv("Embed::Persistent::eval_file",
 715                            G_DISCARD | G_EVAL, args);
 716
 717             /* check $@ */
 718             if(SvTRUE(GvSV(errgv)))
 719                 fprintf(stderr, "eval error: %s\n", SvPV(GvSV(errgv),na));
 720         }
 721      }
 722
 723      perl_destruct_level = 0;
 724      perl_destruct(perl);
 725      perl_free(perl);
 726      exit(exitstatus);
 727  }
 728
 729
 730 Now compile:
 731
 732  % cc -o persistent persistent.c `perl -MExtUtils::Embed -e ldopts`
 733
 734 Here's a example script file:
 735
 736  #test.pl
 737  my $string = "hello";
 738  foo($string);
 739
 740  sub foo {
 741      print "foo says: @_\n";
 742  }
 743
 744 Now run:
 745
 746  % persistent
 747  Enter file name: test.pl
 748  foo says: hello
 749  Enter file name: test.pl
 750  already compiled Embed::test_2epl->handler
 751  foo says: hello
 752  Enter file name: ^C
 753
 754 =head2 Maintaining multiple interpreter instances
 755
 756 The previous examples have gone through several steps to startup, use and
 757 shutdown an embedded Perl interpreter.  Certain applications may require
 758 more than one instance of an interpreter to be created during the lifespan
 759 of a single process.  Such an application may take different approaches in
 760 it's use of interpreter objects.  For example, a particular transaction may
 761 want to create an interpreter instance, then release any resources associated
 762 with the object once the transaction is completed.  When a single process
 763 does this once, resources are released upon exit of the program and the next
 764 time it starts, the interpreter's global state is fresh.
 765
 766 In the same process, the program must take care to ensure that these
 767 actions take place before constructing a new interpreter.  By default, the
 768 global variable C<perl_destruct_level> is set to C<0> since extra cleaning
 769 is not needed when a program constructs a single interpreter, such as the
 770 perl executable itself in C</usr/bin/perl> or some such.
 771
 772 You can tell Perl to make everything squeeky clean by setting
 773 C<perl_destruct_level> to C<1>.
 774
 775  perl_destruct_level = 1; /* perl global variable */
 776  while(1) {
 777      ...
 778      /* reset global variables here with perl_destruct_level = 1 */
 779      perl_contruct(my_perl);
 780      ...
 781      /* clean and reset _everything_ during perl_destruct */
 782      perl_destruct(my_perl); /* ah, nice and fresh */
 783      perl_free(my_perl);
 784      ...
 785      /* let's go do it again! */
 786  }
 787
 788 Now, when I<perl_destruct()> is called, the interpreter's syntax parsetree
 789 and symbol tables are cleaned out, along with reseting global variables.
 790
 791 So, we've seen how to startup and shutdown an interpreter more than once
 792 in the same process, but there was only one instance in existance at any
 793 one time.  Hmm, wonder if we can have more than one interpreter instance
 794 running at the _same_ time?
 795 Indeed this is possible, however when you build Perl, you must compile with
 796 C<-DMULTIPLICITY>.
 797
 798 It's a little tricky for the Perl runtime to handle multiple interpreters,
 799 introducing some overhead that most programs with a single interpreter don't
 800 get burdened with.  When you compile with C<-DMULTIPLICITY>, by default,
 801 C<perl_destruct_level> is set to C<1> for each interpreter.
 802
 803 Let's give it a try:
 804
 805
 806  #include <EXTERN.h>
 807  #include <perl.h>
 808
 809
 810  /* we're going to embed two interpreters */
 811  /* we're going to embed two interpreters */
 812
 813
 814  #define SAY_HELLO "-e", "print qq(Hi, I'm $^X\n)"
 815
 816
 817  int main(int argc, char **argv, char **env)
 818  {
 819      PerlInterpreter
 820          *one_perl = perl_alloc(),
 821          *two_perl = perl_alloc();
 822      char *one_args[] = { "one_perl", SAY_HELLO };
 823      char *two_args[] = { "two_perl", SAY_HELLO };
 824
 825      perl_construct(one_perl);
 826      perl_construct(two_perl);
 827
 828      perl_parse(one_perl, NULL, 3, one_args, (char **)NULL);
 829      perl_parse(two_perl, NULL, 3, two_args, (char **)NULL);
 830
 831      perl_run(one_perl);
 832      perl_run(two_perl);
 833
 834      perl_destruct(one_perl);
 835      perl_destruct(two_perl);
 836
 837      perl_free(one_perl);
 838      perl_free(two_perl);
 839  }
 840
 841
 842 Compile as usual:
 843
 844  % cc -o multiplicity multiplicity.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
 845
 846 Run it, Run it:
 847
 848  % multiplicity
 849  Hi, I'm one_perl
 850  Hi, I'm two_perl
 851
 852 =head2 Using Perl modules, which themselves use C libraries, from your C program
 853
 854 If you've played with the examples above and tried to embed a script
 855 that I<use()>s a Perl module (such as I<Socket>) which itself uses a C or C++ library,
 856 this probably happened:
 857
 858
 859  Can't load module Socket, dynamic loading not available in this perl.
 860   (You may need to build a new perl executable which either supports
 861   dynamic loading or has the Socket module statically linked into it.)
 862
 863
 864 What's wrong?
 865
 866 Your interpreter doesn't know how to communicate with these extensions
 867 on its own.  A little glue will help.  Up until now you've been
 868 calling I<perl_parse()>, handing it NULL for the second argument:
 869
 870  perl_parse(my_perl, NULL, argc, my_argv, NULL);
 871
 872 That's where the glue code can be inserted to create the initial contact between
 873 Perl and linked C/C++ routines.  Let's take a look some pieces of I<perlmain.c>
 874 to see how Perl does this:
 875
 876
 877  #ifdef __cplusplus
 878  #  define EXTERN_C extern "C"
 879  #else
 880  #  define EXTERN_C extern
 881  #endif
 882
 883  static void xs_init _((void));
 884
 885  EXTERN_C void boot_DynaLoader _((CV* cv));
 886  EXTERN_C void boot_Socket _((CV* cv));
 887
 888
 889  EXTERN_C void
 890  xs_init()
 891  {
 892         char *file = __FILE__;
 893         /* DynaLoader is a special case */
 894         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 895         newXS("Socket::bootstrap", boot_Socket, file);
 896  }
 897
 898 Simply put: for each extension linked with your Perl executable
 899 (determined during its initial configuration on your
 900 computer or when adding a new extension),
 901 a Perl subroutine is created to incorporate the extension's
 902 routines.  Normally, that subroutine is named
 903 I<Module::bootstrap()> and is invoked when you say I<use Module>.  In
 904 turn, this hooks into an XSUB, I<boot_Module>, which creates a Perl
 905 counterpart for each of the extension's XSUBs.  Don't worry about this
 906 part; leave that to the I<xsubpp> and extension authors.  If your
 907 extension is dynamically loaded, DynaLoader creates I<Module::bootstrap()>
 908 for you on the fly.  In fact, if you have a working DynaLoader then there
 909 is rarely any need to link in any other extensions statically.
 910
 911
 912 Once you have this code, slap it into the second argument of I<perl_parse()>:
 913
 914
 915  perl_parse(my_perl, xs_init, argc, my_argv, NULL);
 916
 917
 918 Then compile:
 919
 920  % cc -o interp interp.c `perl -MExtUtils::Embed -e ldopts`
 921
 922  % interp
 923    use Socket;
 924    use SomeDynamicallyLoadedModule;
 925
 926    print "Now I can use extensions!\n"'
 927
 928 B<ExtUtils::Embed> can also automate writing the I<xs_init> glue code.
 929
 930  % perl -MExtUtils::Embed -e xsinit -o perlxsi.c
 931  % cc -c perlxsi.c `perl -MExtUtils::Embed -e ccopts`
 932  % cc -c interp.c  `perl -MExtUtils::Embed -e ccopts`
 933  % cc -o interp perlxsi.o interp.o `perl -MExtUtils::Embed -e ldopts`
 934
 935 Consult L<perlxs> and L<perlguts> for more details.
 936
 937
 938 =head1 MORAL
 939
 940 You can sometimes I<write faster code> in C, but
 941 you can always I<write code faster> in Perl.  Because you can use
 942 each from the other, combine them as you wish.
 943
 944
 945 =head1 AUTHOR
 946
 947 Jon Orwant F<E<lt>orwant@media.mit.eduE<gt>>,
 948 co-authored by Doug MacEachern F<E<lt>dougm@osf.orgE<gt>>,
 949 with contributions from
 950 Tim Bunce, Tom Christiansen, Dov Grobgeld, and Ilya
 951 Zakharevich.
 952
 953 June 17, 1996
 954
 955 Some of this material is excerpted from my book: I<Perl 5 Interactive>,
 956 Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears
 957 courtesy of Waite Group Press.