home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.1 (User) / OpenStep 4.1 (User).iso / usr / lib / perl5 / ExtUtils / Miniperl.pm < prev    next >
Encoding:
Perl POD Document  |  1996-09-10  |  2.0 KB  |  106 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. #include "EXTERN.h"
  21. #include "perl.h"
  22.  
  23. static void xs_init _((void));
  24. static PerlInterpreter *my_perl;
  25.  
  26. int
  27. main(argc, argv, env)
  28. int argc;
  29. char **argv;
  30. char **env;
  31. {
  32.     int exitstatus;
  33.  
  34. #ifdef VMS
  35.     getredirection(&argc,&argv);
  36. #endif
  37.  
  38.     if (!do_undump) {
  39.     my_perl = perl_alloc();
  40.     if (!my_perl)
  41.         exit(1);
  42.     perl_construct( my_perl );
  43.     }
  44.  
  45.     exitstatus = perl_parse( my_perl, xs_init, argc, argv, env );
  46.     if (exitstatus)
  47.     exit( exitstatus );
  48.  
  49.     exitstatus = perl_run( my_perl );
  50.  
  51.     perl_destruct( my_perl );
  52.     perl_free( my_perl );
  53.  
  54.     exit( exitstatus );
  55. }
  56.  
  57. /* Register any extra external extensions */
  58.  
  59. static void
  60. xs_init()
  61. {
  62. EOF!HEAD
  63. $tail=<<'EOF!TAIL';
  64. }
  65. EOF!TAIL
  66.  
  67. sub writemain{
  68.     my(@exts) = @_;
  69.  
  70.     my($pname);
  71.     my($dl) = canon('/','DynaLoader');
  72.     print $head;
  73.     print "    char *file = __FILE__;\n";
  74.     foreach $_ (@exts){
  75.     my($pname) = canon('/', $_);
  76.     my($mname, $cname);
  77.     ($mname = $pname) =~ s!/!::!g;
  78.     ($cname = $pname) =~ s!/!__!g;
  79.     print "\t{   extern void boot_${cname} _((CV* cv));\n";
  80.     if ($pname eq $dl){
  81.         # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  82.         # boot_DynaLoader is called directly in DynaLoader.pm
  83.         print "\t/* DynaLoader is a special case */\n";
  84.         print "\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n"
  85.     } else {
  86.         print "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n"
  87.     }
  88.     print "\t}\n";
  89.     }
  90.     print $tail;
  91. }
  92.  
  93. sub canon{
  94.     my($as, @ext) = @_;
  95.     foreach(@ext){
  96.         # might be X::Y or lib/auto/X/Y/Y.a
  97.         next if s!::!/!g;
  98.         s:^(lib|ext)/(auto/)?::;
  99.         s:/\w+\.\w+$::;
  100.     }
  101.     grep(s:/:$as:, @ext) if ($as ne '/');
  102.     @ext;
  103. }
  104.  
  105. 1;
  106.