Commit | Line | Data |
fed7345c |
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 |