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