minimod.PL

   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
  57     foreach $_ (@exts){
  58         my($pname) = canon('/', $_);
  59         my($mname, $cname);
  60         ($mname = $pname) =~ s!/!::!g;
  61         ($cname = $pname) =~ s!/!__!g;
  62         print "EXTERN_C void boot_${cname} _((CV* cv));\n";
  63     }
  64
  65     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
  66     print $tail1;
  67
  68     print "     char *file = __FILE__;\n";
  69     foreach $_ (@exts){
  70         my($pname) = canon('/', $_);
  71         my($mname, $cname, $ccode);
  72         ($mname = $pname) =~ s!/!::!g;
  73         ($cname = $pname) =~ s!/!__!g;
  74         print "\t{\n";
  75         if ($pname eq $dl){
  76             # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  77             # boot_DynaLoader is called directly in DynaLoader.pm
  78             $ccode = "\t/* DynaLoader is a special case */\n
  79 \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
  80             print $ccode unless $SEEN{$ccode}++;
  81         } else {
  82             $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
  83             print $ccode unless $SEEN{$ccode}++;
  84         }
  85         print "\t}\n";
  86     }
  87     print $tail2;
  88 }
  89
  90 sub canon{
  91     my($as, @ext) = @_;
  92         foreach(@ext){
  93             # might be X::Y or lib/auto/X/Y/Y.a
  94                 next if s!::!/!g;
  95             s:^(lib|ext)/(auto/)?::;
  96             s:/\w+\.\w+$::;
  97         }
  98         grep(s:/:$as:, @ext) if ($as ne '/');
  99         @ext;
 100 }
 101
 102 1;
 103 END