home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2J (Developer) / os42jdev.iso / NextDeveloper / Source / GNU / perl / Perl / minimod.PL < prev    next >
Perl Script  |  1995-02-13  |  2KB  |  90 lines
  1. # minimod.PL writes the contents of miniperlmain.c into the module
  2. # ExtUtils::Miniperl for later perusal (when the perl source is
  3. # deleted)
  4. #
  5. # It also writes the subroutine writemain(), which takes as its
  6. # arguments module names that shall be statically linked into perl.
  7. #
  8. # Authors: Andreas Koenig <k@franz.ww.TU-Berlin.DE>, Tim Bunce
  9. #          <Tim.Bunce@ig.co.uk>
  10. #
  11. # Version 1.0, Feb 2nd 1995 by Andreas Koenig
  12.  
  13. print <<'END';
  14. # This File keeps the contents of miniperlmain.c.
  15. #
  16. # It was generated automatically by minimod.PL from the contents
  17. # of miniperlmain.c. Don't edit this file!
  18. #
  19. #       ANY CHANGES MADE HERE WILL BE LOST! 
  20. #
  21.  
  22.  
  23. package ExtUtils::Miniperl;
  24. require Exporter;
  25. @ISA = qw(Exporter);
  26. @EXPORT = qw(&writemain);
  27.  
  28. $head= <<'EOF!HEAD';
  29. END
  30.  
  31. open MINI, "miniperlmain.c";
  32. while (<MINI>) {
  33.     last if /Do not delete this line--writemain depends on it/;
  34.     print;
  35. }
  36.  
  37. print <<'END';
  38. EOF!HEAD
  39. $tail=<<'EOF!TAIL';
  40. END
  41.  
  42. while (<MINI>) {
  43.     print;
  44. }
  45. close MINI;
  46.  
  47. print <<'END';
  48. EOF!TAIL
  49.  
  50. sub writemain{
  51.     my(@exts) = @_;
  52.  
  53.     my($pname);
  54.     my($dl) = canon('/','DynaLoader');
  55.     print $head;
  56.     print "    char *file = __FILE__;\n";
  57.     foreach $_ (@exts){
  58.     my($pname) = canon('/', $_);
  59.     my($mname, $cname);
  60.     ($mname = $pname) =~ s!/!::!g;
  61.     ($cname = $pname) =~ s!/!__!g;
  62.     print "\t{   extern void boot_${cname} _((CV* cv));\n";
  63.     if ($pname eq $dl){
  64.         # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  65.         # boot_DynaLoader is called directly in DynaLoader.pm
  66.         print "\t/* DynaLoader is a special case */\n";
  67.         print "\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n"
  68.     } else {
  69.         print "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n"
  70.     }
  71.     print "\t}\n";
  72.     }
  73.     print $tail;
  74. }
  75.  
  76. sub canon{
  77.     my($as, @ext) = @_;
  78.     foreach(@ext){
  79.         # might be X::Y or lib/auto/X/Y/Y.a
  80.         next if s!::!/!g;
  81.         s:^(lib|ext)/(auto/)?::;
  82.         s:/\w+\.\w+$::;
  83.     }
  84.     grep(s:/:$as:, @ext) if ($as ne '/');
  85.     @ext;
  86. }
  87.  
  88. 1;
  89. END
  90.