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