home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / ExtUtils / Miniperl.pm < prev    next >
Text File  |  1998-04-17  |  4KB  |  182 lines
  1. # This File keeps the contents of miniperlmain.c.
  2. #
  3. # It was generated automatically by minimod.PL from the contents
  4. # of miniperlmain.c. Don't edit this file!
  5. #
  6. #       ANY CHANGES MADE HERE WILL BE LOST! 
  7. #
  8.  
  9.  
  10. package ExtUtils::Miniperl;
  11. require Exporter;
  12. @ISA = qw(Exporter);
  13. @EXPORT = qw(&writemain);
  14.  
  15. $head= <<'EOF!HEAD';
  16. /*
  17.  * "The Road goes ever on and on, down from the door where it began."
  18.  */
  19.  
  20. #ifdef __cplusplus
  21. extern "C" {
  22. #endif
  23.  
  24. #include "EXTERN.h"
  25. #include "perl.h"
  26.  
  27. #ifdef __cplusplus
  28. }
  29. #  define EXTERN_C extern "C"
  30. #else
  31. #  define EXTERN_C extern
  32. #endif
  33.  
  34. static void xs_init _((void));
  35. static PerlInterpreter *my_perl;
  36.  
  37. int
  38. #ifdef CAN_PROTOTYPE
  39. main(int argc, char **argv, char **env)
  40. #else
  41. main(argc, argv, env)
  42. int argc;
  43. char **argv;
  44. char **env;
  45. #endif
  46. {
  47.     int exitstatus;
  48.  
  49.     PERL_SYS_INIT(&argc,&argv);
  50.  
  51.     perl_init_i18nl10n(1);
  52.  
  53. #if !defined(macintosh) || !defined(MULTIPLICITY)
  54.     if (!do_undump) {
  55. #endif
  56. #ifdef macintosh
  57.     if (!gDebugLogName || !(gPerlDbg = fopen(gDebugLogName, "w")))
  58.          gPerlDbg = stderr;
  59. #endif
  60.     my_perl = perl_alloc();
  61.     if (!my_perl)
  62.         exit(1);
  63.     perl_construct( my_perl );
  64. #if !defined(macintosh) || !defined(MULTIPLICITY)
  65.     perl_destruct_level = 0;
  66.     }
  67. #endif
  68.  
  69.     exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
  70.     if (!exitstatus) {
  71.     exitstatus = perl_run( my_perl );
  72.     }
  73.  
  74.     perl_destruct( my_perl );
  75.     perl_free( my_perl );
  76.  
  77.     PERL_SYS_TERM();
  78.  
  79.     exit( exitstatus );
  80. }
  81.  
  82. /* Register any extra external extensions */
  83.  
  84. EOF!HEAD
  85. $tail=<<'EOF!TAIL';
  86.  
  87. static void
  88. xs_init()
  89. {
  90. }
  91. EOF!TAIL
  92.  
  93. sub writemain{
  94.     my(@exts) = @_;
  95.  
  96.     my($pname);
  97.     my($dl) = canon('/','DynaLoader');
  98.     print $head;
  99.  
  100.     foreach $_ (@exts){
  101.     my($pname) = canon('/', $_);
  102.     my($mname, $cname);
  103.     ($mname = $pname) =~ s!/!::!g;
  104.     ($cname = $pname) =~ s!/!__!g;
  105.     print "EXTERN_C void boot_${cname} _((CV* cv));\n";
  106.     }
  107.  
  108.     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
  109.     print $tail1;
  110.  
  111.     print "\tchar *file = __FILE__;\n";
  112.     print "\tdXSUB_SYS;\n" if $] > 5.002;
  113.  
  114.     foreach $_ (@exts){
  115.     my($pname) = canon('/', $_);
  116.     my($mname, $cname, $ccode);
  117.     ($mname = $pname) =~ s!/!::!g;
  118.     ($cname = $pname) =~ s!/!__!g;
  119.     print "\t{\n";
  120.     if ($pname eq $dl){
  121.         # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  122.         # boot_DynaLoader is called directly in DynaLoader.pm
  123.         $ccode = "\t/* DynaLoader is a special case */\n
  124. \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
  125.         print $ccode unless $SEEN{$ccode}++;
  126.     } else {
  127.         $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
  128.         print $ccode unless $SEEN{$ccode}++;
  129.     }
  130.     print "\t}\n";
  131.     }
  132.     print $tail2;
  133. }
  134.  
  135. sub canon{
  136.     my($as, @ext) = @_;
  137.     foreach(@ext){
  138.         # might be X::Y or lib/auto/X/Y/Y.a
  139.         next if s!::!/!g;
  140.         s:^(lib|ext)/(auto/)?::;
  141.         s:/\w+\.\w+$::;
  142.     }
  143.     grep(s:/:$as:, @ext) if ($as ne '/');
  144.     @ext;
  145. }
  146.  
  147. 1;
  148. __END__
  149.  
  150. =head1 NAME
  151.  
  152. ExtUtils::Miniperl, writemain - write the C code for perlmain.c
  153.  
  154. =head1 SYNOPSIS
  155.  
  156. C<use ExtUtils::Miniperl;>
  157.  
  158. C<writemain(@directories);>
  159.  
  160. =head1 DESCRIPTION
  161.  
  162. This whole module is written when perl itself is built from a script
  163. called minimod.PL. In case you want to patch it, please patch
  164. minimod.PL in the perl distribution instead.
  165.  
  166. writemain() takes an argument list of directories containing archive
  167. libraries that relate to perl modules and should be linked into a new
  168. perl binary. It writes to STDOUT a corresponding perlmain.c file that
  169. is a plain C file containing all the bootstrap code to make the
  170. modules associated with the libraries available from within perl.
  171.  
  172. The typical usage is from within a Makefile generated by
  173. ExtUtils::MakeMaker. So under normal circumstances you won't have to
  174. deal with this module directly.
  175.  
  176. =head1 SEE ALSO
  177.  
  178. L<ExtUtils::MakeMaker>
  179.  
  180. =cut
  181.  
  182.