Mingw32 PERL_OBJECT tweaks
[p5sagit/p5-mst-13.2.git] / 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<perlxs>, L<perlxstut> and L<h2xs>.
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 do(), eval(), require(), and use() in L<perlfunc>.
24
25 =item B<Use C from C?>
26
27 Rethink your design.
28
29 =item B<Use Perl from C?>
30
31 Read on...
32
33 =back
34
35 =head2 ROADMAP
36
37 Compiling your C program
38
39 There's one example in each of the nine sections:
40
41 =over 4
42
43 =item *
44
45 Adding a Perl interpreter to your C program
46
47 =item *
48
49 Calling a Perl subroutine from your C program
50
51 =item *
52
53 Evaluating a Perl statement from your C program
54
55 =item *
56
57 Performing Perl pattern matches and substitutions from your C program
58
59 =item *
60
61 Fiddling with the Perl stack from your C program
62
63 =item *
64
65 Maintaining a persistent interpreter
66
67 =item *
68
69 Maintaining multiple interpreter instances
70
71 =item *
72
73 Using Perl modules, which themselves use C libraries, from your C program
74
75 =item *
76
77 Embedding Perl under Win32
78
79 =back
80
81 =head2 Compiling your C program
82
83 If you have trouble compiling the scripts in this documentation,
84 you're not alone.  The cardinal rule: COMPILE THE PROGRAMS IN EXACTLY
85 THE SAME WAY THAT YOUR PERL WAS COMPILED.  (Sorry for yelling.)
86
87 Also, every C program that uses Perl must link in the I<perl library>.
88 What's that, you ask?  Perl is itself written in C; the perl library
89 is the collection of compiled C programs that were used to create your
90 perl executable (I</usr/bin/perl> or equivalent).  (Corollary: you
91 can't use Perl from your C program unless Perl has been compiled on
92 your machine, or installed properly--that's why you shouldn't blithely
93 copy Perl executables from machine to machine without also copying the
94 I<lib> directory.)
95
96 When you use Perl from C, your C program will--usually--allocate,
97 "run", and deallocate a I<PerlInterpreter> object, which is defined by
98 the perl library.
99
100 If your copy of Perl is recent enough to contain this documentation
101 (version 5.002 or later), then the perl library (and I<EXTERN.h> and
102 I<perl.h>, which you'll also need) will reside in a directory
103 that looks like this:
104
105     /usr/local/lib/perl5/your_architecture_here/CORE
106
107 or perhaps just
108
109     /usr/local/lib/perl5/CORE
110
111 or maybe something like
112
113     /usr/opt/perl5/CORE
114
115 Execute this statement for a hint about where to find CORE:
116
117     perl -MConfig -e 'print $Config{archlib}'
118
119 Here's how you'd compile the example in the next section,
120 Adding a Perl interpreter to your C program, on my Linux box:
121
122     % gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include
123     -I/usr/local/lib/perl5/i586-linux/5.003/CORE
124     -L/usr/local/lib/perl5/i586-linux/5.003/CORE
125     -o interp interp.c -lperl -lm
126
127 (That's all one line.)  On my DEC Alpha running 5.003_05, the incantation
128 is a bit different:
129
130     % cc -O2 -Olimit 2900 -DSTANDARD_C -I/usr/local/include
131     -I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE
132     -L/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE -L/usr/local/lib
133     -D__LANGUAGE_C__ -D_NO_PROTO -o interp interp.c -lperl -lm
134
135 How can you figure out what to add?  Assuming your Perl is post-5.001,
136 execute a C<perl -V> command and pay special attention to the "cc" and
137 "ccflags" information.
138
139 You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.) for
140 your machine: C<perl -MConfig -e 'print $Config{cc}'> will tell you what
141 to use.
142
143 You'll also have to choose the appropriate library directory
144 (I</usr/local/lib/...>) for your machine.  If your compiler complains
145 that certain functions are undefined, or that it can't locate
146 I<-lperl>, then you need to change the path following the C<-L>.  If it
147 complains that it can't find I<EXTERN.h> and I<perl.h>, you need to
148 change the path following the C<-I>.
149
150 You may have to add extra libraries as well.  Which ones?
151 Perhaps those printed by
152
153    perl -MConfig -e 'print $Config{libs}'
154
155 Provided your perl binary was properly configured and installed the
156 B<ExtUtils::Embed> module will determine all of this information for
157 you:
158
159    % cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
160
161 If the B<ExtUtils::Embed> module isn't part of your Perl distribution,
162 you can retrieve it from
163 http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils::Embed.  (If
164 this documentation came from your Perl distribution, then you're
165 running 5.004 or better and you already have it.)
166
167 The B<ExtUtils::Embed> kit on CPAN also contains all source code for
168 the examples in this document, tests, additional examples and other
169 information you may find useful.
170
171 =head2 Adding a Perl interpreter to your C program
172
173 In a sense, perl (the C program) is a good example of embedding Perl
174 (the language), so I'll demonstrate embedding with I<miniperlmain.c>,
175 from the source distribution.  Here's a bastardized, nonportable
176 version of I<miniperlmain.c> containing the essentials of embedding:
177
178     #include <EXTERN.h>               /* from the Perl distribution     */
179     #include <perl.h>                 /* from the Perl distribution     */
180
181     static PerlInterpreter *my_perl;  /***    The Perl interpreter    ***/
182
183     int main(int argc, char **argv, char **env)
184     {
185         my_perl = perl_alloc();
186         perl_construct(my_perl);
187         perl_parse(my_perl, NULL, argc, argv, (char **)NULL);
188         perl_run(my_perl);
189         perl_destruct(my_perl);
190         perl_free(my_perl);
191     }
192
193 Notice that we don't use the C<env> pointer.  Normally handed to
194 C<perl_parse> as its final argument, C<env> here is replaced by
195 C<NULL>, which means that the current environment will be used.
196
197 Now compile this program (I'll call it I<interp.c>) into an executable:
198
199     % cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
200
201 After a successful compilation, you'll be able to use I<interp> just
202 like perl itself:
203
204     % interp
205     print "Pretty Good Perl \n";
206     print "10890 - 9801 is ", 10890 - 9801;
207     <CTRL-D>
208     Pretty Good Perl
209     10890 - 9801 is 1089
210
211 or
212
213     % interp -e 'printf("%x", 3735928559)'
214     deadbeef
215
216 You can also read and execute Perl statements from a file while in the
217 midst of your C program, by placing the filename in I<argv[1]> before
218 calling I<perl_run()>.
219
220 =head2 Calling a Perl subroutine from your C program
221
222 To call individual Perl subroutines, you can use any of the B<perl_call_*>
223 functions documented in L<perlcall>.
224 In this example we'll use perl_call_argv().
225
226 That's shown below, in a program I'll call I<showtime.c>.
227
228     #include <EXTERN.h>
229     #include <perl.h>
230
231     static PerlInterpreter *my_perl;
232
233     int main(int argc, char **argv, char **env)
234     {
235         char *args[] = { NULL };
236         my_perl = perl_alloc();
237         perl_construct(my_perl);
238
239         perl_parse(my_perl, NULL, argc, argv, NULL);
240
241         /*** skipping perl_run() ***/
242
243         perl_call_argv("showtime", G_DISCARD | G_NOARGS, args);
244
245         perl_destruct(my_perl);
246         perl_free(my_perl);
247     }
248
249 where I<showtime> is a Perl subroutine that takes no arguments (that's the
250 I<G_NOARGS>) and for which I'll ignore the return value (that's the
251 I<G_DISCARD>).  Those flags, and others, are discussed in L<perlcall>.
252
253 I'll define the I<showtime> subroutine in a file called I<showtime.pl>:
254
255     print "I shan't be printed.";
256
257     sub showtime {
258         print time;
259     }
260
261 Simple enough.  Now compile and run:
262
263     % cc -o showtime showtime.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
264
265     % showtime showtime.pl
266     818284590
267
268 yielding the number of seconds that elapsed between January 1, 1970
269 (the beginning of the Unix epoch), and the moment I began writing this
270 sentence.
271
272 In this particular case we don't have to call I<perl_run>, but in
273 general it's considered good practice to ensure proper initialization
274 of library code, including execution of all object C<DESTROY> methods
275 and package C<END {}> blocks.
276
277 If you want to pass arguments to the Perl subroutine, you can add
278 strings to the C<NULL>-terminated C<args> list passed to
279 I<perl_call_argv>.  For other data types, or to examine return values,
280 you'll need to manipulate the Perl stack.  That's demonstrated in the
281 last section of this document: Fiddling with the Perl stack from
282 your C program.
283
284 =head2 Evaluating a Perl statement from your C program
285
286 Perl provides two API functions to evaluate pieces of Perl code.
287 These are perl_eval_sv() and perl_eval_pv().
288
289 Arguably, these are the only routines you'll ever need to execute
290 snippets of Perl code from within your C program.  Your code can be
291 as long as you wish; it can contain multiple statements; it can employ
292 use(), require(), and do() to include external Perl files.
293
294 perl_eval_pv() lets us evaluate individual Perl strings, and then
295 extract variables for coercion into C types.  The following program,
296 I<string.c>, executes three Perl strings, extracting an C<int> from
297 the first, a C<float> from the second, and a C<char *> from the third.
298
299    #include <EXTERN.h>
300    #include <perl.h>
301    
302    static PerlInterpreter *my_perl;
303    
304    main (int argc, char **argv, char **env)
305    {
306        char *embedding[] = { "", "-e", "0" };
307    
308        my_perl = perl_alloc();
309        perl_construct( my_perl );
310    
311        perl_parse(my_perl, NULL, 3, embedding, NULL);
312        perl_run(my_perl);
313    
314        /** Treat $a as an integer **/
315        perl_eval_pv("$a = 3; $a **= 2", TRUE);
316        printf("a = %d\n", SvIV(perl_get_sv("a", FALSE)));
317    
318        /** Treat $a as a float **/
319        perl_eval_pv("$a = 3.14; $a **= 2", TRUE);
320        printf("a = %f\n", SvNV(perl_get_sv("a", FALSE)));
321    
322        /** Treat $a as a string **/
323        perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
324        printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), na));
325    
326        perl_destruct(my_perl);
327        perl_free(my_perl);
328    }
329
330 All of those strange functions with I<sv> in their names help convert Perl scalars to C types.  They're described in L<perlguts>.
331
332 If you compile and run I<string.c>, you'll see the results of using
333 I<SvIV()> to create an C<int>, I<SvNV()> to create a C<float>, and
334 I<SvPV()> to create a string:
335
336    a = 9
337    a = 9.859600
338    a = Just Another Perl Hacker
339
340 In the example above, we've created a global variable to temporarily
341 store the computed value of our eval'd expression.  It is also
342 possible and in most cases a better strategy to fetch the return value
343 from perl_eval_pv() instead.  Example:
344
345    ...
346    SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
347    printf("%s\n", SvPV(val,na));
348    ...
349
350 This way, we avoid namespace pollution by not creating global
351 variables and we've simplified our code as well.
352
353 =head2 Performing Perl pattern matches and substitutions from your C program
354
355 The I<perl_eval_sv()> function lets us evaluate chunks of Perl code, so we can
356 define some functions that use it to "specialize" in matches and
357 substitutions: I<match()>, I<substitute()>, and I<matches()>.
358
359    char match(SV *string, char *pattern);
360
361 Given a string and a pattern (e.g., C<m/clasp/> or C</\b\w*\b/>, which
362 in your C program might appear as "/\\b\\w*\\b/"), match()
363 returns 1 if the string matches the pattern and 0 otherwise.
364
365    int substitute(SV **string, char *pattern);
366
367 Given a pointer to an C<SV> and an C<=~> operation (e.g.,
368 C<s/bob/robert/g> or C<tr[A-Z][a-z]>), substitute() modifies the string
369 within the C<AV> at according to the operation, returning the number of substitutions
370 made.
371
372    int matches(SV *string, char *pattern, AV **matches);
373
374 Given an C<SV>, a pattern, and a pointer to an empty C<AV>,
375 matches() evaluates C<$string =~ $pattern> in an array context, and
376 fills in I<matches> with the array elements, returning the number of matches found.
377
378 Here's a sample program, I<match.c>, that uses all three (long lines have
379 been wrapped here):
380
381  #include <EXTERN.h>
382  #include <perl.h>
383  
384  /** my_perl_eval_sv(code, error_check)
385  ** kinda like perl_eval_sv(), 
386  ** but we pop the return value off the stack 
387  **/
388  SV* my_perl_eval_sv(SV *sv, I32 croak_on_error)
389  {
390      dSP;
391      SV* retval;
392  
393      PUSHMARK(SP);
394      perl_eval_sv(sv, G_SCALAR);
395  
396      SPAGAIN;
397      retval = POPs;
398      PUTBACK;
399  
400      if (croak_on_error && SvTRUE(GvSV(errgv)))
401         croak(SvPVx(GvSV(errgv), na));
402  
403      return retval;
404  }
405  
406  /** match(string, pattern)
407  **
408  ** Used for matches in a scalar context.
409  **
410  ** Returns 1 if the match was successful; 0 otherwise.
411  **/
412  
413  I32 match(SV *string, char *pattern)
414  {
415      SV *command = NEWSV(1099, 0), *retval;
416  
417      sv_setpvf(command, "my $string = '%s'; $string =~ %s",
418               SvPV(string,na), pattern);
419  
420      retval = my_perl_eval_sv(command, TRUE);
421      SvREFCNT_dec(command);
422  
423      return SvIV(retval);
424  }
425  
426  /** substitute(string, pattern)
427  **
428  ** Used for =~ operations that modify their left-hand side (s/// and tr///)
429  **
430  ** Returns the number of successful matches, and
431  ** modifies the input string if there were any.
432  **/
433  
434  I32 substitute(SV **string, char *pattern)
435  {
436      SV *command = NEWSV(1099, 0), *retval;
437  
438      sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
439               SvPV(*string,na), pattern);
440  
441      retval = my_perl_eval_sv(command, TRUE);
442      SvREFCNT_dec(command);
443  
444      *string = perl_get_sv("string", FALSE);
445      return SvIV(retval);
446  }
447  
448  /** matches(string, pattern, matches)
449  **
450  ** Used for matches in an array context.
451  **
452  ** Returns the number of matches,
453  ** and fills in **matches with the matching substrings
454  **/
455  
456  I32 matches(SV *string, char *pattern, AV **match_list)
457  {
458      SV *command = NEWSV(1099, 0);
459      I32 num_matches;
460  
461      sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
462               SvPV(string,na), pattern);
463  
464      my_perl_eval_sv(command, TRUE);
465      SvREFCNT_dec(command);
466  
467      *match_list = perl_get_av("array", FALSE);
468      num_matches = av_len(*match_list) + 1; /** assume $[ is 0 **/
469  
470      return num_matches;
471  }
472  
473  main (int argc, char **argv, char **env)
474  {
475      PerlInterpreter *my_perl = perl_alloc();
476      char *embedding[] = { "", "-e", "0" };
477      AV *match_list;
478      I32 num_matches, i;
479      SV *text = NEWSV(1099,0);
480  
481      perl_construct(my_perl);
482      perl_parse(my_perl, NULL, 3, embedding, NULL);
483  
484      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");
485  
486      if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/
487         printf("match: Text contains the word 'quarter'.\n\n");
488      else
489         printf("match: Text doesn't contain the word 'quarter'.\n\n");
490  
491      if (match(text, "m/eighth/")) /** Does text contain 'eighth'? **/
492         printf("match: Text contains the word 'eighth'.\n\n");
493      else
494         printf("match: Text doesn't contain the word 'eighth'.\n\n");
495  
496      /** Match all occurrences of /wi../ **/
497      num_matches = matches(text, "m/(wi..)/g", &match_list);
498      printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
499  
500      for (i = 0; i < num_matches; i++)
501         printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),na));
502      printf("\n");
503  
504      /** Remove all vowels from text **/
505      num_matches = substitute(&text, "s/[aeiou]//gi");
506      if (num_matches) {
507         printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
508                num_matches);
509         printf("Now text is: %s\n\n", SvPV(text,na));
510      }
511  
512      /** Attempt a substitution **/
513      if (!substitute(&text, "s/Perl/C/")) {
514         printf("substitute: s/Perl/C...No substitution made.\n\n");
515      }
516  
517      SvREFCNT_dec(text);
518      perl_destruct_level = 1;
519      perl_destruct(my_perl);
520      perl_free(my_perl);
521  }
522
523 which produces the output (again, long lines have been wrapped here)
524
525    match: Text contains the word 'quarter'.
526
527    match: Text doesn't contain the word 'eighth'.
528
529    matches: m/(wi..)/g found 2 matches...
530    match: will
531    match: with
532
533    substitute: s/[aeiou]//gi...139 substitutions made.
534    Now text is: Whn h s t  cnvnnc str nd th bll cms t sm mnt lk 76 cnts,
535    Mynrd s wr tht thr s smthng h *shld* d, smthng tht wll nbl hm t gt bck
536    qrtr, bt h hs n d *wht*.  H fmbls thrgh hs rd sqzy chngprs nd gvs th by
537    thr xtr pnns wth hs dllr, hpng tht h mght lck nt th crrct mnt.  Th by gvs
538    hm bck tw f hs wn pnns nd thn th bg shny qrtr tht s hs prz. -RCHH
539
540    substitute: s/Perl/C...No substitution made.
541
542 =head2 Fiddling with the Perl stack from your C program
543
544 When trying to explain stacks, most computer science textbooks mumble
545 something about spring-loaded columns of cafeteria plates: the last
546 thing you pushed on the stack is the first thing you pop off.  That'll
547 do for our purposes: your C program will push some arguments onto "the Perl
548 stack", shut its eyes while some magic happens, and then pop the
549 results--the return value of your Perl subroutine--off the stack.
550
551 First you'll need to know how to convert between C types and Perl
552 types, with newSViv() and sv_setnv() and newAV() and all their
553 friends.  They're described in L<perlguts>.
554
555 Then you'll need to know how to manipulate the Perl stack.  That's
556 described in L<perlcall>.
557
558 Once you've understood those, embedding Perl in C is easy.
559
560 Because C has no builtin function for integer exponentiation, let's
561 make Perl's ** operator available to it (this is less useful than it
562 sounds, because Perl implements ** with C's I<pow()> function).  First
563 I'll create a stub exponentiation function in I<power.pl>:
564
565     sub expo {
566         my ($a, $b) = @_;
567         return $a ** $b;
568     }
569
570 Now I'll create a C program, I<power.c>, with a function
571 I<PerlPower()> that contains all the perlguts necessary to push the
572 two arguments into I<expo()> and to pop the return value out.  Take a
573 deep breath...
574
575     #include <EXTERN.h>
576     #include <perl.h>
577
578     static PerlInterpreter *my_perl;
579
580     static void
581     PerlPower(int a, int b)
582     {
583       dSP;                            /* initialize stack pointer      */
584       ENTER;                          /* everything created after here */
585       SAVETMPS;                       /* ...is a temporary variable.   */
586       PUSHMARK(SP);                   /* remember the stack pointer    */
587       XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack  */
588       XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack  */
589       PUTBACK;                      /* make local stack pointer global */
590       perl_call_pv("expo", G_SCALAR); /* call the function             */
591       SPAGAIN;                        /* refresh stack pointer         */
592                                     /* pop the return value from stack */
593       printf ("%d to the %dth power is %d.\n", a, b, POPi);
594       PUTBACK;
595       FREETMPS;                       /* free that return value        */
596       LEAVE;                       /* ...and the XPUSHed "mortal" args.*/
597     }
598
599     int main (int argc, char **argv, char **env)
600     {
601       char *my_argv[] = { "", "power.pl" };
602
603       my_perl = perl_alloc();
604       perl_construct( my_perl );
605
606       perl_parse(my_perl, NULL, 2, my_argv, (char **)NULL);
607       perl_run(my_perl);
608
609       PerlPower(3, 4);                      /*** Compute 3 ** 4 ***/
610
611       perl_destruct(my_perl);
612       perl_free(my_perl);
613     }
614
615
616
617 Compile and run:
618
619     % cc -o power power.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
620
621     % power
622     3 to the 4th power is 81.
623
624 =head2 Maintaining a persistent interpreter
625
626 When developing interactive and/or potentially long-running
627 applications, it's a good idea to maintain a persistent interpreter
628 rather than allocating and constructing a new interpreter multiple
629 times.  The major reason is speed: since Perl will only be loaded into
630 memory once.
631
632 However, you have to be more cautious with namespace and variable
633 scoping when using a persistent interpreter.  In previous examples
634 we've been using global variables in the default package C<main>.  We
635 knew exactly what code would be run, and assumed we could avoid
636 variable collisions and outrageous symbol table growth.
637
638 Let's say your application is a server that will occasionally run Perl
639 code from some arbitrary file.  Your server has no way of knowing what
640 code it's going to run.  Very dangerous.
641
642 If the file is pulled in by C<perl_parse()>, compiled into a newly
643 constructed interpreter, and subsequently cleaned out with
644 C<perl_destruct()> afterwards, you're shielded from most namespace
645 troubles.
646
647 One way to avoid namespace collisions in this scenario is to translate
648 the filename into a guaranteed-unique package name, and then compile
649 the code into that package using eval().  In the example
650 below, each file will only be compiled once.  Or, the application
651 might choose to clean out the symbol table associated with the file
652 after it's no longer needed.  Using perl_call_argv(), We'll
653 call the subroutine C<Embed::Persistent::eval_file> which lives in the
654 file C<persistent.pl> and pass the filename and boolean cleanup/cache
655 flag as arguments.
656
657 Note that the process will continue to grow for each file that it
658 uses.  In addition, there might be C<AUTOLOAD>ed subroutines and other
659 conditions that cause Perl's symbol table to grow.  You might want to
660 add some logic that keeps track of the process size, or restarts
661 itself after a certain number of requests, to ensure that memory
662 consumption is minimized.  You'll also want to scope your variables
663 with my() whenever possible.
664
665
666  package Embed::Persistent;
667  #persistent.pl
668
669  use strict;
670  use vars '%Cache';
671  use Symbol qw(delete_package);
672
673  sub valid_package_name {
674      my($string) = @_;
675      $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
676      # second pass only for words starting with a digit
677      $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
678
679      # Dress it up as a real package name
680      $string =~ s|/|::|g;
681      return "Embed" . $string;
682  }
683
684  sub eval_file {
685      my($filename, $delete) = @_;
686      my $package = valid_package_name($filename);
687      my $mtime = -M $filename;
688      if(defined $Cache{$package}{mtime}
689         &&
690         $Cache{$package}{mtime} <= $mtime)
691      {
692         # we have compiled this subroutine already,
693         # it has not been updated on disk, nothing left to do
694         print STDERR "already compiled $package->handler\n";
695      }
696      else {
697         local *FH;
698         open FH, $filename or die "open '$filename' $!";
699         local($/) = undef;
700         my $sub = <FH>;
701         close FH;
702
703         #wrap the code into a subroutine inside our unique package
704         my $eval = qq{package $package; sub handler { $sub; }};
705         {
706             # hide our variables within this block
707             my($filename,$mtime,$package,$sub);
708             eval $eval;
709         }
710         die $@ if $@;
711
712         #cache it unless we're cleaning out each time
713         $Cache{$package}{mtime} = $mtime unless $delete;
714      }
715
716      eval {$package->handler;};
717      die $@ if $@;
718
719      delete_package($package) if $delete;
720
721      #take a look if you want
722      #print Devel::Symdump->rnew($package)->as_string, $/;
723  }
724
725  1;
726
727  __END__
728
729  /* persistent.c */
730  #include <EXTERN.h>
731  #include <perl.h>
732
733  /* 1 = clean out filename's symbol table after each request, 0 = don't */
734  #ifndef DO_CLEAN
735  #define DO_CLEAN 0
736  #endif
737
738  static PerlInterpreter *perl = NULL;
739
740  int
741  main(int argc, char **argv, char **env)
742  {
743      char *embedding[] = { "", "persistent.pl" };
744      char *args[] = { "", DO_CLEAN, NULL };
745      char filename [1024];
746      int exitstatus = 0;
747
748      if((perl = perl_alloc()) == NULL) {
749         fprintf(stderr, "no memory!");
750         exit(1);
751      }
752      perl_construct(perl);
753
754      exitstatus = perl_parse(perl, NULL, 2, embedding, NULL);
755
756      if(!exitstatus) {
757         exitstatus = perl_run(perl);
758
759         while(printf("Enter file name: ") && gets(filename)) {
760
761             /* call the subroutine, passing it the filename as an argument */
762             args[0] = filename;
763             perl_call_argv("Embed::Persistent::eval_file",
764                            G_DISCARD | G_EVAL, args);
765
766             /* check $@ */
767             if(SvTRUE(GvSV(errgv)))
768                 fprintf(stderr, "eval error: %s\n", SvPV(GvSV(errgv),na));
769         }
770      }
771
772      perl_destruct_level = 0;
773      perl_destruct(perl);
774      perl_free(perl);
775      exit(exitstatus);
776  }
777
778 Now compile:
779
780  % cc -o persistent persistent.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
781
782 Here's a example script file:
783
784  #test.pl
785  my $string = "hello";
786  foo($string);
787
788  sub foo {
789      print "foo says: @_\n";
790  }
791
792 Now run:
793
794  % persistent
795  Enter file name: test.pl
796  foo says: hello
797  Enter file name: test.pl
798  already compiled Embed::test_2epl->handler
799  foo says: hello
800  Enter file name: ^C
801
802 =head2 Maintaining multiple interpreter instances
803
804 Some rare applications will need to create more than one interpreter
805 during a session.  Such an application might sporadically decide to
806 release any resources associated with the interpreter.
807
808 The program must take care to ensure that this takes place I<before>
809 the next interpreter is constructed.  By default, the global variable
810 C<perl_destruct_level> is set to C<0>, since extra cleaning isn't
811 needed when a program has only one interpreter.
812
813 Setting C<perl_destruct_level> to C<1> makes everything squeaky clean:
814
815  perl_destruct_level = 1;
816
817  while(1) {
818      ...
819      /* reset global variables here with perl_destruct_level = 1 */
820      perl_construct(my_perl);
821      ...
822      /* clean and reset _everything_ during perl_destruct */
823      perl_destruct(my_perl);
824      perl_free(my_perl);
825      ...
826      /* let's go do it again! */
827  }
828
829 When I<perl_destruct()> is called, the interpreter's syntax parse tree
830 and symbol tables are cleaned up, and global variables are reset.
831
832 Now suppose we have more than one interpreter instance running at the
833 same time.  This is feasible, but only if you used the
834 C<-DMULTIPLICITY> flag when building Perl.  By default, that sets
835 C<perl_destruct_level> to C<1>.
836
837 Let's give it a try:
838
839
840  #include <EXTERN.h>
841  #include <perl.h>
842
843  /* we're going to embed two interpreters */
844  /* we're going to embed two interpreters */
845
846  #define SAY_HELLO "-e", "print qq(Hi, I'm $^X\n)"
847
848  int main(int argc, char **argv, char **env)
849  {
850      PerlInterpreter
851          *one_perl = perl_alloc(),
852          *two_perl = perl_alloc();
853      char *one_args[] = { "one_perl", SAY_HELLO };
854      char *two_args[] = { "two_perl", SAY_HELLO };
855
856      perl_construct(one_perl);
857      perl_construct(two_perl);
858
859      perl_parse(one_perl, NULL, 3, one_args, (char **)NULL);
860      perl_parse(two_perl, NULL, 3, two_args, (char **)NULL);
861
862      perl_run(one_perl);
863      perl_run(two_perl);
864
865      perl_destruct(one_perl);
866      perl_destruct(two_perl);
867
868      perl_free(one_perl);
869      perl_free(two_perl);
870  }
871
872
873 Compile as usual:
874
875  % cc -o multiplicity multiplicity.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
876
877 Run it, Run it:
878
879  % multiplicity
880  Hi, I'm one_perl
881  Hi, I'm two_perl
882
883 =head2 Using Perl modules, which themselves use C libraries, from your C program
884
885 If you've played with the examples above and tried to embed a script
886 that I<use()>s a Perl module (such as I<Socket>) which itself uses a C or C++ library,
887 this probably happened:
888
889
890  Can't load module Socket, dynamic loading not available in this perl.
891   (You may need to build a new perl executable which either supports
892   dynamic loading or has the Socket module statically linked into it.)
893
894
895 What's wrong?
896
897 Your interpreter doesn't know how to communicate with these extensions
898 on its own.  A little glue will help.  Up until now you've been
899 calling I<perl_parse()>, handing it NULL for the second argument:
900
901  perl_parse(my_perl, NULL, argc, my_argv, NULL);
902
903 That's where the glue code can be inserted to create the initial contact between
904 Perl and linked C/C++ routines.  Let's take a look some pieces of I<perlmain.c>
905 to see how Perl does this:
906
907
908  #ifdef __cplusplus
909  #  define EXTERN_C extern "C"
910  #else
911  #  define EXTERN_C extern
912  #endif
913
914  static void xs_init _((void));
915
916  EXTERN_C void boot_DynaLoader _((CV* cv));
917  EXTERN_C void boot_Socket _((CV* cv));
918
919
920  EXTERN_C void
921  xs_init()
922  {
923         char *file = __FILE__;
924         /* DynaLoader is a special case */
925         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
926         newXS("Socket::bootstrap", boot_Socket, file);
927  }
928
929 Simply put: for each extension linked with your Perl executable
930 (determined during its initial configuration on your
931 computer or when adding a new extension),
932 a Perl subroutine is created to incorporate the extension's
933 routines.  Normally, that subroutine is named
934 I<Module::bootstrap()> and is invoked when you say I<use Module>.  In
935 turn, this hooks into an XSUB, I<boot_Module>, which creates a Perl
936 counterpart for each of the extension's XSUBs.  Don't worry about this
937 part; leave that to the I<xsubpp> and extension authors.  If your
938 extension is dynamically loaded, DynaLoader creates I<Module::bootstrap()>
939 for you on the fly.  In fact, if you have a working DynaLoader then there
940 is rarely any need to link in any other extensions statically.
941
942
943 Once you have this code, slap it into the second argument of I<perl_parse()>:
944
945
946  perl_parse(my_perl, xs_init, argc, my_argv, NULL);
947
948
949 Then compile:
950
951  % cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
952
953  % interp
954    use Socket;
955    use SomeDynamicallyLoadedModule;
956
957    print "Now I can use extensions!\n"'
958
959 B<ExtUtils::Embed> can also automate writing the I<xs_init> glue code.
960
961  % perl -MExtUtils::Embed -e xsinit -- -o perlxsi.c
962  % cc -c perlxsi.c `perl -MExtUtils::Embed -e ccopts`
963  % cc -c interp.c  `perl -MExtUtils::Embed -e ccopts`
964  % cc -o interp perlxsi.o interp.o `perl -MExtUtils::Embed -e ldopts`
965
966 Consult L<perlxs> and L<perlguts> for more details.
967
968 =head1 Embedding Perl under Win32
969
970 At the time of this writing, there are two versions of Perl which run
971 under Win32.  Interfacing to Activeware's Perl library is quite
972 different from the examples in this documentation, as significant
973 changes were made to the internal Perl API.  However, it is possible
974 to embed Activeware's Perl runtime, see the Perl for Win32 FAQ:
975 http://www.perl.com/perl/faq/win32/Perl_for_Win32_FAQ.html
976
977 With the "official" Perl version 5.004 or higher, all the examples
978 within this documentation will compile and run untouched, although,
979 the build process is slightly different between Unix and Win32.  
980
981 For starters, backticks don't work under the Win32 native command shell!
982 The ExtUtils::Embed kit on CPAN ships with a script called
983 B<genmake>, which generates a simple makefile to build a program from
984 a single C source file.  It can be used like so:
985
986  C:\ExtUtils-Embed\eg> perl genmake interp.c
987  C:\ExtUtils-Embed\eg> nmake
988  C:\ExtUtils-Embed\eg> interp -e "print qq{I'm embedded in Win32!\n}"
989
990 You may wish to use a more robust environment such as the MS Developer
991 stdio.  In this case, to generate perlxsi.c run:
992
993  perl -MExtUtils::Embed -e xsinit
994
995 Create a new project, Insert -> Files into Project: perlxsi.c, perl.lib,
996 and your own source files, e.g. interp.c.  Typically you'll find
997 perl.lib in B<C:\perl\lib\CORE>, if not, you should see the B<CORE>
998 directory relative to C<perl -V:archlib>.
999 The studio will also need this path so it knows where to find Perl
1000 include files.  This path can be added via the Tools -> Options ->
1001 Directories menu.  Finnally, select Build -> Build interp.exe and
1002 you're ready to go!
1003
1004 =head1 MORAL
1005
1006 You can sometimes I<write faster code> in C, but
1007 you can always I<write code faster> in Perl.  Because you can use
1008 each from the other, combine them as you wish.
1009
1010
1011 =head1 AUTHOR
1012
1013 Jon Orwant and <F<orwant@tpj.com>> and Doug MacEachern <F<dougm@osf.org>>,
1014 with small contributions from Tim Bunce, Tom Christiansen, Hallvard Furuseth,
1015 Dov Grobgeld, and Ilya Zakharevich.
1016
1017 Check out Doug's article on embedding in Volume 1, Issue 4 of The Perl
1018 Journal.  Info about TPJ is available from http://tpj.com.
1019
1020 July 17, 1997
1021
1022 Some of this material is excerpted from Jon Orwant's book: I<Perl 5
1023 Interactive>, Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears
1024 courtesy of Waite Group Press.
1025
1026 =head1 COPYRIGHT
1027
1028 Copyright (C) 1995, 1996, 1997 Doug MacEachern and Jon Orwant.  All
1029 Rights Reserved.
1030
1031 Although destined for release with the standard Perl distribution,
1032 this document is not public domain, nor is any of Perl and its
1033 documentation.  Permission is granted to freely distribute verbatim
1034 copies of this document provided that no modifications outside of
1035 formatting be made, and that this notice remain intact.  You are
1036 permitted and encouraged to use its code and derivatives thereof in
1037 your own source code for fun or for profit as you see fit.