377ee8bbaf2f2db62f609f56f477dca5f7dc32d1
[p5sagit/p5-mst-13.2.git] / minimod.pl
1 #./miniperl -w
2 # minimod.PL writes the contents of miniperlmain.c into the module
3 # ExtUtils::Miniperl for later perusal (when the perl source is
4 # deleted)
5 #
6 # It also writes the subroutine writemain(), which takes as its
7 # arguments module names that shall be statically linked into perl.
8 #
9 # Authors: Andreas Koenig <k@franz.ww.TU-Berlin.DE>, Tim Bunce
10 #          <Tim.Bunce@ig.co.uk>
11 #
12 # Version 1.0, Feb 2nd 1995 by Andreas Koenig
13
14 use strict;
15
16 print <<'END';
17 # This File keeps the contents of miniperlmain.c.
18 #
19 # It was generated automatically by minimod.PL from the contents
20 # of miniperlmain.c. Don't edit this file!
21 #
22 #       ANY CHANGES MADE HERE WILL BE LOST! 
23 #
24
25
26 package ExtUtils::Miniperl;
27 require Exporter;
28 @ISA = qw(Exporter);
29 @EXPORT = qw(&writemain);
30
31 $head= <<'EOF!HEAD';
32 END
33
34 open MINI, "miniperlmain.c";
35 while (<MINI>) {
36     last if /Do not delete this line--writemain depends on it/;
37     print;
38 }
39
40 print <<'END';
41 EOF!HEAD
42 $tail=<<'EOF!TAIL';
43 END
44
45 while (<MINI>) {
46     print unless /dXSUB_SYS/;
47 }
48 close MINI;
49
50 print <<'END';
51 EOF!TAIL
52
53 sub writemain{
54     my(@exts) = @_;
55
56     my($pname);
57     my($dl) = canon('/','DynaLoader');
58     print $head;
59
60     foreach $_ (@exts){
61         my($pname) = canon('/', $_);
62         my($mname, $cname);
63         ($mname = $pname) =~ s!/!::!g;
64         ($cname = $pname) =~ s!/!__!g;
65         print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
66     }
67
68     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
69     print $tail1;
70
71     print "\tconst char file[] = __FILE__;\n";
72     print "\tdXSUB_SYS;\n" if $] > 5.002;
73
74     foreach $_ (@exts){
75         my($pname) = canon('/', $_);
76         my($mname, $cname, $ccode);
77         ($mname = $pname) =~ s!/!::!g;
78         ($cname = $pname) =~ s!/!__!g;
79         print "\t{\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             $ccode = "\t/* DynaLoader is a special case */\n
84 \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
85             print $ccode unless $SEEN{$ccode}++;
86         } else {
87             $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
88             print $ccode unless $SEEN{$ccode}++;
89         }
90         print "\t}\n";
91     }
92     print $tail2;
93 }
94
95 sub canon{
96     my($as, @ext) = @_;
97         foreach(@ext){
98             # might be X::Y or lib/auto/X/Y/Y.a
99                 next if s!::!/!g;
100             s:^(lib|ext)/(auto/)?::;
101             s:/\w+\.\w+$::;
102         }
103         grep(s:/:$as:, @ext) if ($as ne '/');
104         @ext;
105 }
106
107 1;
108 __END__
109
110 =head1 NAME
111
112 ExtUtils::Miniperl, writemain - write the C code for perlmain.c
113
114 =head1 SYNOPSIS
115
116 C<use ExtUtils::Miniperl;>
117
118 C<writemain(@directories);>
119
120 =head1 DESCRIPTION
121
122 This whole module is written when perl itself is built from a script
123 called minimod.PL. In case you want to patch it, please patch
124 minimod.PL in the perl distribution instead.
125
126 writemain() takes an argument list of directories containing archive
127 libraries that relate to perl modules and should be linked into a new
128 perl binary. It writes to STDOUT a corresponding perlmain.c file that
129 is a plain C file containing all the bootstrap code to make the
130 modules associated with the libraries available from within perl.
131
132 The typical usage is from within a Makefile generated by
133 ExtUtils::MakeMaker. So under normal circumstances you won't have to
134 deal with this module directly.
135
136 =head1 SEE ALSO
137
138 L<ExtUtils::MakeMaker>
139
140 =cut
141
142 END