Commit | Line | Data |
---|---|---|
52cebf5e EP |
1 | #!/usr/local/bin/perl |
2 | ||
3 | use Config; | |
4 | use File::Basename qw(&basename &dirname); | |
de0d1968 | 5 | use File::Spec; |
8a5546a1 | 6 | use Cwd; |
52cebf5e EP |
7 | |
8 | # List explicitly here the variables you want Configure to | |
9 | # generate. Metaconfig only looks for shell variables, so you | |
10 | # have to mention them as if they were shell variables, not | |
11 | # %Config entries. Thus you write | |
12 | # $startperl | |
13 | # to ensure Configure will look for $Config{startperl}. | |
14 | # Wanted: $archlibexp | |
15 | ||
16 | # This forces PL files to create target in same directory as PL file. | |
17 | # This is so that make depend always knows where to find PL derivatives. | |
8a5546a1 | 18 | $origdir = cwd; |
52cebf5e EP |
19 | chdir dirname($0); |
20 | $file = basename($0, '.PL'); | |
21 | $file .= '.com' if $^O eq 'VMS'; | |
22 | ||
23 | open OUT,">$file" or die "Can't create $file: $!"; | |
24 | ||
25 | print "Extracting $file (with variable substitutions)\n"; | |
26 | ||
27 | # In this section, perl variables will be expanded during extraction. | |
28 | # You can use $Config{...} to use Configure variables. | |
29 | ||
30 | print OUT <<"!GROK!THIS!"; | |
31 | $Config{startperl} | |
32 | eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' | |
33 | if \$running_under_some_shell; | |
ecde9bf0 | 34 | --\$running_under_some_shell; |
52cebf5e EP |
35 | !GROK!THIS! |
36 | ||
37 | # In the following, perl variables are not expanded during extraction. | |
38 | ||
39 | print OUT <<'!NO!SUBS!'; | |
40 | ||
ecde9bf0 SC |
41 | # Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000 |
42 | # Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000 | |
43 | # Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000 | |
e4f0d88d | 44 | # Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001 |
d1c9eea3 | 45 | # Version 2.04, Enache Adrian,Fri, 18 Jul 2003 23:15:37 +0300 |
ecde9bf0 | 46 | |
52cebf5e | 47 | use strict; |
ecde9bf0 | 48 | use warnings; |
33024943 | 49 | use 5.006_000; |
52cebf5e | 50 | |
e4f0d88d | 51 | use FileHandle; |
ecde9bf0 SC |
52 | use Config; |
53 | use Fcntl qw(:DEFAULT :flock); | |
54 | use File::Temp qw(tempfile); | |
55 | use Cwd; | |
d1c9eea3 | 56 | our $VERSION = 2.04; |
ecde9bf0 | 57 | $| = 1; |
52cebf5e | 58 | |
e4f0d88d EP |
59 | $SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves. |
60 | ||
ecde9bf0 SC |
61 | use subs qw{ |
62 | cc_harness check_read check_write checkopts_byte choose_backend | |
63 | compile_byte compile_cstyle compile_module generate_code | |
64 | grab_stash parse_argv sanity_check vprint yclept spawnit | |
65 | }; | |
66 | sub opt(*); # imal quoting | |
b326da91 MB |
67 | sub is_win32(); |
68 | sub is_msvc(); | |
52cebf5e | 69 | |
ecde9bf0 SC |
70 | our ($Options, $BinPerl, $Backend); |
71 | our ($Input => $Output); | |
e4f0d88d EP |
72 | our ($logfh); |
73 | our ($cfile); | |
b326da91 | 74 | our (@begin_output); # output from BEGIN {}, for testsuite |
ef712cf7 | 75 | |
ecde9bf0 | 76 | # eval { main(); 1 } or die; |
52cebf5e EP |
77 | |
78 | main(); | |
79 | ||
e4f0d88d | 80 | sub main { |
ecde9bf0 SC |
81 | parse_argv(); |
82 | check_write($Output); | |
83 | choose_backend(); | |
84 | generate_code(); | |
e4f0d88d EP |
85 | run_code(); |
86 | _die("XXX: Not reached?"); | |
52cebf5e | 87 | } |
9636a016 | 88 | |
ecde9bf0 | 89 | ####################################################################### |
52cebf5e | 90 | |
ecde9bf0 SC |
91 | sub choose_backend { |
92 | # Choose the backend. | |
93 | $Backend = 'C'; | |
94 | if (opt(B)) { | |
95 | checkopts_byte(); | |
96 | $Backend = 'Bytecode'; | |
52cebf5e | 97 | } |
ecde9bf0 SC |
98 | if (opt(S) && opt(c)) { |
99 | # die "$0: Do you want me to compile this or not?\n"; | |
100 | delete $Options->{S}; | |
52cebf5e | 101 | } |
ecde9bf0 | 102 | $Backend = 'CC' if opt(O); |
52cebf5e EP |
103 | } |
104 | ||
52cebf5e | 105 | |
ecde9bf0 | 106 | sub generate_code { |
a07043ec | 107 | |
ecde9bf0 | 108 | vprint 0, "Compiling $Input"; |
9636a016 | 109 | |
ecde9bf0 | 110 | $BinPerl = yclept(); # Calling convention for perl. |
52cebf5e | 111 | |
ecde9bf0 SC |
112 | if (opt(shared)) { |
113 | compile_module(); | |
114 | } else { | |
115 | if ($Backend eq 'Bytecode') { | |
116 | compile_byte(); | |
117 | } else { | |
118 | compile_cstyle(); | |
119 | } | |
52cebf5e | 120 | } |
e4f0d88d EP |
121 | exit(0) if (!opt('r')); |
122 | } | |
52cebf5e | 123 | |
e4f0d88d EP |
124 | sub run_code { |
125 | vprint 0, "Running code"; | |
126 | run("$Output @ARGV"); | |
127 | exit(0); | |
52cebf5e EP |
128 | } |
129 | ||
ecde9bf0 SC |
130 | # usage: vprint [level] msg args |
131 | sub vprint { | |
132 | my $level; | |
133 | if (@_ == 1) { | |
134 | $level = 1; | |
135 | } elsif ($_[0] =~ /^\d$/) { | |
136 | $level = shift; | |
137 | } else { | |
138 | # well, they forgot to use a number; means >0 | |
139 | $level = 0; | |
140 | } | |
141 | my $msg = "@_"; | |
142 | $msg .= "\n" unless substr($msg, -1) eq "\n"; | |
e4f0d88d EP |
143 | if (opt(v) > $level) |
144 | { | |
145 | print "$0: $msg" if !opt('log'); | |
146 | print $logfh "$0: $msg" if opt('log'); | |
147 | } | |
148 | } | |
ecde9bf0 SC |
149 | |
150 | sub parse_argv { | |
151 | ||
152 | use Getopt::Long; | |
f5eac215 JH |
153 | |
154 | # disallows using long arguments | |
155 | # Getopt::Long::Configure("bundling"); | |
156 | ||
ecde9bf0 SC |
157 | Getopt::Long::Configure("no_ignore_case"); |
158 | ||
159 | # no difference in exists and defined for %ENV; also, a "0" | |
160 | # argument or a "" would not help cc, so skip | |
161 | unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS}; | |
162 | ||
163 | $Options = {}; | |
164 | Getopt::Long::GetOptions( $Options, | |
165 | 'L:s', # lib directory | |
166 | 'I:s', # include directories (FOR C, NOT FOR PERL) | |
167 | 'o:s', # Output executable | |
b326da91 | 168 | 'v:i', # Verbosity level |
ecde9bf0 | 169 | 'e:s', # One-liner |
e4f0d88d | 170 | 'r', # run resulting executable |
ecde9bf0 SC |
171 | 'B', # Byte compiler backend |
172 | 'O', # Optimised C backend | |
173 | 'c', # Compile only | |
174 | 'h', # Help me | |
175 | 'S', # Dump C files | |
e4f0d88d | 176 | 'r', # run the resulting executable |
b326da91 MB |
177 | 'T', # run the backend using perl -T |
178 | 't', # run the backend using perl -t | |
e4f0d88d | 179 | 'static', # Dirty hack to enable -shared/-static |
ecde9bf0 | 180 | 'shared', # Create a shared library (--shared for compat.) |
b326da91 | 181 | 'log:s', # where to log compilation process information |
9d2bbe64 | 182 | 'Wb:s', # pass (comma-sepearated) options to backend |
b326da91 | 183 | 'testsuite', # try to be nice to testsuite |
ecde9bf0 | 184 | ); |
b326da91 | 185 | |
ecde9bf0 | 186 | $Options->{v} += 0; |
52cebf5e | 187 | |
b326da91 MB |
188 | if( opt(t) && opt(T) ) { |
189 | warn "Can't specify both -T and -t, -t ignored"; | |
190 | $Options->{t} = 0; | |
191 | } | |
192 | ||
ecde9bf0 | 193 | helpme() if opt(h); # And exit |
ef712cf7 | 194 | |
b326da91 MB |
195 | $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' ); |
196 | $Output = is_win32() ? $Output : relativize($Output); | |
e4f0d88d | 197 | $logfh = new FileHandle(">> " . opt('log')) if (opt('log')); |
ef712cf7 | 198 | |
ecde9bf0 SC |
199 | if (opt(e)) { |
200 | warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV; | |
201 | # We don't use a temporary file here; why bother? | |
202 | # XXX: this is not bullet proof -- spaces or quotes in name! | |
b326da91 MB |
203 | $Input = is_win32() ? # Quotes eaten by shell |
204 | '-e "'.opt(e).'"' : | |
205 | "-e '".opt(e)."'"; | |
ecde9bf0 SC |
206 | } else { |
207 | $Input = shift @ARGV; # XXX: more files? | |
e4f0d88d | 208 | _usage_and_die("$0: No input file specified\n") unless $Input; |
ecde9bf0 SC |
209 | # DWIM modules. This is bad but necessary. |
210 | $Options->{shared}++ if $Input =~ /\.pm\z/; | |
211 | warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV; | |
212 | check_read($Input); | |
213 | check_perl($Input); | |
214 | sanity_check(); | |
52cebf5e EP |
215 | } |
216 | ||
ecde9bf0 | 217 | } |
5268c7a4 | 218 | |
ecde9bf0 SC |
219 | sub opt(*) { |
220 | my $opt = shift; | |
221 | return exists($Options->{$opt}) && ($Options->{$opt} || 0); | |
222 | } | |
52cebf5e | 223 | |
ecde9bf0 SC |
224 | sub compile_module { |
225 | die "$0: Compiling to shared libraries is currently disabled\n"; | |
52cebf5e EP |
226 | } |
227 | ||
ecde9bf0 | 228 | sub compile_byte { |
1df34986 AE |
229 | my $command = "$BinPerl -MO=Bytecode,-H,-o$Output $Input"; |
230 | $Input =~ s/^-e.*$/-e/; | |
52cebf5e | 231 | |
d873810b | 232 | my ($output_r, $error_r) = spawnit($command); |
52cebf5e | 233 | |
d873810b | 234 | if (@$error_r && $? != 0) { |
1df34986 | 235 | _die("$0: $Input did not compile:\n@$error_r\n"); |
d873810b NC |
236 | } else { |
237 | my @error = grep { !/^$Input syntax OK$/o } @$error_r; | |
238 | warn "$0: Unexpected compiler output:\n@error" if @error; | |
ef712cf7 | 239 | } |
b326da91 | 240 | |
e4f0d88d | 241 | chmod 0777 & ~umask, $Output or _die("can't chmod $Output: $!"); |
ecde9bf0 | 242 | exit 0; |
52cebf5e | 243 | } |
52cebf5e | 244 | |
ecde9bf0 SC |
245 | sub compile_cstyle { |
246 | my $stash = grab_stash(); | |
b326da91 MB |
247 | my $taint = opt(T) ? '-T' : |
248 | opt(t) ? '-t' : ''; | |
249 | ||
ecde9bf0 | 250 | # What are we going to call our output C file? |
ecde9bf0 | 251 | my $lose = 0; |
e4f0d88d | 252 | my ($cfh); |
b326da91 | 253 | my $testsuite = ''; |
9d2bbe64 MB |
254 | my $addoptions = opt(Wb); |
255 | ||
256 | if( $addoptions ) { | |
257 | $addoptions .= ',' if $addoptions !~ m/,$/; | |
258 | } | |
b326da91 MB |
259 | |
260 | if (opt(testsuite)) { | |
261 | my $bo = join '', @begin_output; | |
262 | $bo =~ s/\\/\\\\\\\\/gs; | |
263 | $bo =~ s/\n/\\n/gs; | |
264 | $bo =~ s/,/\\054/gs; | |
265 | # don't look at that: it hurts | |
266 | $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}. | |
267 | qq[-e"print q{$bo}",] . | |
268 | q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} . | |
269 | q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",}; | |
270 | } | |
ecde9bf0 SC |
271 | if (opt(S) || opt(c)) { |
272 | # We need to keep it. | |
273 | if (opt(e)) { | |
274 | $cfile = "a.out.c"; | |
275 | } else { | |
276 | $cfile = $Input; | |
277 | # File off extension if present | |
278 | # hold on: plx is executable; also, careful of ordering! | |
279 | $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i; | |
280 | $cfile .= ".c"; | |
281 | $cfile = $Output if opt(c) && $Output =~ /\.c\z/i; | |
282 | } | |
283 | check_write($cfile); | |
284 | } else { | |
285 | # Don't need to keep it, be safe with a tempfile. | |
286 | $lose = 1; | |
287 | ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c"); | |
288 | close $cfh; # See comment just below | |
52cebf5e | 289 | } |
ecde9bf0 | 290 | vprint 1, "Writing C on $cfile"; |
52cebf5e | 291 | |
ecde9bf0 SC |
292 | my $max_line_len = ''; |
293 | if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) { | |
294 | $max_line_len = '-l2000,'; | |
295 | } | |
52cebf5e | 296 | |
ecde9bf0 SC |
297 | # This has to do the write itself, so we can't keep a lock. Life |
298 | # sucks. | |
9d2bbe64 | 299 | my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input"; |
ecde9bf0 SC |
300 | vprint 1, "Compiling..."; |
301 | vprint 1, "Calling $command"; | |
52cebf5e | 302 | |
ecde9bf0 SC |
303 | my ($output_r, $error_r) = spawnit($command); |
304 | my @output = @$output_r; | |
305 | my @error = @$error_r; | |
52cebf5e | 306 | |
ecde9bf0 | 307 | if (@error && $? != 0) { |
e4f0d88d | 308 | _die("$0: $Input did not compile, which can't happen:\n@error\n"); |
ecde9bf0 | 309 | } |
52cebf5e | 310 | |
b326da91 MB |
311 | is_msvc ? |
312 | cc_harness_msvc($cfile,$stash) : | |
313 | cc_harness($cfile,$stash) unless opt(c); | |
52cebf5e | 314 | |
ecde9bf0 SC |
315 | if ($lose) { |
316 | vprint 2, "unlinking $cfile"; | |
e4f0d88d | 317 | unlink $cfile or _die("can't unlink $cfile: $!"); |
ecde9bf0 | 318 | } |
52cebf5e EP |
319 | } |
320 | ||
b326da91 MB |
321 | sub cc_harness_msvc { |
322 | my ($cfile,$stash)=@_; | |
323 | use ExtUtils::Embed (); | |
324 | my $obj = "${Output}.obj"; | |
325 | my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile "; | |
326 | my $link = "-out:$Output $obj"; | |
327 | $compile .= " -I".$_ for split /\s+/, opt(I); | |
328 | $link .= " -libpath:".$_ for split /\s+/, opt(L); | |
329 | my @mods = split /-?u /, $stash; | |
330 | $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods); | |
784a4a22 | 331 | $link .= " perl5$Config{PERL_VERSION}.lib kernel32.lib msvcrt.lib"; |
b326da91 MB |
332 | vprint 3, "running $Config{cc} $compile"; |
333 | system("$Config{cc} $compile"); | |
334 | vprint 3, "running $Config{ld} $link"; | |
335 | system("$Config{ld} $link"); | |
336 | } | |
337 | ||
ecde9bf0 SC |
338 | sub cc_harness { |
339 | my ($cfile,$stash)=@_; | |
340 | use ExtUtils::Embed (); | |
341 | my $command = ExtUtils::Embed::ccopts." -o $Output $cfile "; | |
3af308c7 SC |
342 | $command .= " -I".$_ for split /\s+/, opt(I); |
343 | $command .= " -L".$_ for split /\s+/, opt(L); | |
ecde9bf0 | 344 | my @mods = split /-?u /, $stash; |
3af308c7 | 345 | $command .= " ".ExtUtils::Embed::ldopts("-std", \@mods); |
f5eac215 | 346 | $command .= " -lperl"; |
e4f0d88d EP |
347 | vprint 3, "running $Config{cc} $command"; |
348 | system("$Config{cc} $command"); | |
52cebf5e EP |
349 | } |
350 | ||
ecde9bf0 SC |
351 | # Where Perl is, and which include path to give it. |
352 | sub yclept { | |
353 | my $command = "$^X "; | |
354 | ||
355 | # DWIM the -I to be Perl, not C, include directories. | |
356 | if (opt(I) && $Backend eq "Bytecode") { | |
357 | for (split /\s+/, opt(I)) { | |
358 | if (-d $_) { | |
359 | push @INC, $_; | |
360 | } else { | |
361 | warn "$0: Include directory $_ not found, skipping\n"; | |
362 | } | |
52cebf5e EP |
363 | } |
364 | } | |
ecde9bf0 SC |
365 | |
366 | $command .= "-I$_ " for @INC; | |
367 | return $command; | |
52cebf5e EP |
368 | } |
369 | ||
ecde9bf0 | 370 | # Use B::Stash to find additional modules and stuff. |
52cebf5e | 371 | { |
ecde9bf0 SC |
372 | my $_stash; |
373 | sub grab_stash { | |
52cebf5e | 374 | |
ecde9bf0 | 375 | warn "already called get_stash once" if $_stash; |
52cebf5e | 376 | |
b326da91 MB |
377 | my $taint = opt(T) ? '-T' : |
378 | opt(t) ? '-t' : ''; | |
379 | my $command = "$BinPerl $taint -MB::Stash -c $Input"; | |
ecde9bf0 SC |
380 | # Filename here is perfectly sanitised. |
381 | vprint 3, "Calling $command\n"; | |
9636a016 | 382 | |
ecde9bf0 SC |
383 | my ($stash_r, $error_r) = spawnit($command); |
384 | my @stash = @$stash_r; | |
385 | my @error = @$error_r; | |
52cebf5e | 386 | |
ecde9bf0 | 387 | if (@error && $? != 0) { |
e4f0d88d | 388 | _die("$0: $Input did not compile:\n@error\n"); |
ecde9bf0 | 389 | } |
52cebf5e | 390 | |
b326da91 MB |
391 | # band-aid for modules with noisy BEGIN {} |
392 | foreach my $i ( @stash ) { | |
393 | $i =~ m/-u(?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next; | |
394 | push @begin_output, $i; | |
395 | } | |
396 | chomp $stash[0]; | |
ecde9bf0 | 397 | $stash[0] =~ s/,-u\<none\>//; |
b326da91 | 398 | $stash[0] =~ s/^.*?-u/-u/s; |
ecde9bf0 SC |
399 | vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0]; |
400 | chomp $stash[0]; | |
401 | return $_stash = $stash[0]; | |
52cebf5e EP |
402 | } |
403 | ||
ecde9bf0 | 404 | } |
52cebf5e | 405 | |
ecde9bf0 SC |
406 | # Check the consistency of options if -B is selected. |
407 | # To wit, (-B|-O) ==> no -shared, no -S, no -c | |
408 | sub checkopts_byte { | |
52cebf5e | 409 | |
e4f0d88d | 410 | _die("$0: Please choose one of either -B and -O.\n") if opt(O); |
52cebf5e | 411 | |
ecde9bf0 SC |
412 | if (opt(shared)) { |
413 | warn "$0: Will not create a shared library for bytecode\n"; | |
414 | delete $Options->{shared}; | |
415 | } | |
52cebf5e | 416 | |
ecde9bf0 SC |
417 | for my $o ( qw[c S] ) { |
418 | if (opt($o)) { | |
419 | warn "$0: Compiling to bytecode is a one-pass process--", | |
420 | "-$o ignored\n"; | |
421 | delete $Options->{$o}; | |
422 | } | |
52cebf5e EP |
423 | } |
424 | ||
52cebf5e EP |
425 | } |
426 | ||
ecde9bf0 SC |
427 | # Check the input and output files make sense, are read/writeable. |
428 | sub sanity_check { | |
429 | if ($Input eq $Output) { | |
430 | if ($Input eq 'a.out') { | |
e4f0d88d EP |
431 | _die("$0: Compiling a.out is probably not what you want to do.\n"); |
432 | # You fully deserve what you get now. No you *don't*. typos happen. | |
ecde9bf0 SC |
433 | } else { |
434 | warn "$0: Will not write output on top of input file, ", | |
435 | "compiling to a.out instead\n"; | |
436 | $Output = "a.out"; | |
437 | } | |
52cebf5e EP |
438 | } |
439 | } | |
440 | ||
ecde9bf0 SC |
441 | sub check_read { |
442 | my $file = shift; | |
443 | unless (-r $file) { | |
e4f0d88d | 444 | _die("$0: Input file $file is a directory, not a file\n") if -d _; |
ecde9bf0 | 445 | unless (-e _) { |
e4f0d88d | 446 | _die("$0: Input file $file was not found\n"); |
ecde9bf0 | 447 | } else { |
e4f0d88d | 448 | _die("$0: Cannot read input file $file: $!\n"); |
ecde9bf0 | 449 | } |
52cebf5e | 450 | } |
ecde9bf0 SC |
451 | unless (-f _) { |
452 | # XXX: die? don't try this on /dev/tty | |
453 | warn "$0: WARNING: input $file is not a plain file\n"; | |
454 | } | |
52cebf5e EP |
455 | } |
456 | ||
ecde9bf0 SC |
457 | sub check_write { |
458 | my $file = shift; | |
459 | if (-d $file) { | |
e4f0d88d | 460 | _die("$0: Cannot write on $file, is a directory\n"); |
ecde9bf0 SC |
461 | } |
462 | if (-e _) { | |
e4f0d88d | 463 | _die("$0: Cannot write on $file: $!\n") unless -w _; |
ecde9bf0 SC |
464 | } |
465 | unless (-w cwd()) { | |
e4f0d88d | 466 | _die("$0: Cannot write in this directory: $!\n"); |
ef712cf7 | 467 | } |
ef712cf7 EP |
468 | } |
469 | ||
ecde9bf0 SC |
470 | sub check_perl { |
471 | my $file = shift; | |
472 | unless (-T $file) { | |
473 | warn "$0: Binary `$file' sure doesn't smell like perl source!\n"; | |
474 | print "Checking file type... "; | |
475 | system("file", $file); | |
e4f0d88d | 476 | _die("Please try a perlier file!\n"); |
ecde9bf0 SC |
477 | } |
478 | ||
e4f0d88d | 479 | open(my $handle, "<", $file) or _die("XXX: can't open $file: $!"); |
ecde9bf0 SC |
480 | local $_ = <$handle>; |
481 | if (/^#!/ && !/perl/) { | |
e4f0d88d | 482 | _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n"); |
ecde9bf0 SC |
483 | } |
484 | ||
485 | } | |
486 | ||
487 | # File spawning and error collecting | |
488 | sub spawnit { | |
489 | my ($command) = shift; | |
490 | my (@error,@output); | |
491 | my $errname; | |
492 | (undef, $errname) = tempfile("pccXXXXX"); | |
493 | { | |
494 | open (S_OUT, "$command 2>$errname |") | |
e4f0d88d | 495 | or _die("$0: Couldn't spawn the compiler.\n"); |
ecde9bf0 SC |
496 | @output = <S_OUT>; |
497 | } | |
e4f0d88d | 498 | open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n"); |
ecde9bf0 SC |
499 | @error = <S_ERROR>; |
500 | close S_ERROR; | |
501 | close S_OUT; | |
e4f0d88d | 502 | unlink $errname or _die("$0: Can't unlink error file $errname"); |
ecde9bf0 SC |
503 | return (\@output, \@error); |
504 | } | |
52cebf5e | 505 | |
ecde9bf0 SC |
506 | sub helpme { |
507 | print "perlcc compiler frontend, version $VERSION\n\n"; | |
508 | { no warnings; | |
509 | exec "pod2usage $0"; | |
510 | exec "perldoc $0"; | |
511 | exec "pod2text $0"; | |
512 | } | |
52cebf5e EP |
513 | } |
514 | ||
e4f0d88d EP |
515 | sub relativize { |
516 | my ($args) = @_; | |
517 | ||
518 | return() if ($args =~ m"^[/\\]"); | |
519 | return("./$args"); | |
520 | } | |
521 | ||
522 | sub _die { | |
523 | $logfh->print(@_) if opt('log'); | |
524 | print STDERR @_; | |
525 | exit(); # should die eventually. However, needed so that a 'make compile' | |
526 | # can compile all the way through to the end for standard dist. | |
527 | } | |
528 | ||
529 | sub _usage_and_die { | |
530 | _die(<<EOU); | |
531 | $0: Usage: | |
784a4a22 | 532 | $0 [-o executable] [-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [-log log] [source[.pl] | -e oneliner] |
e4f0d88d EP |
533 | EOU |
534 | } | |
535 | ||
536 | sub run { | |
537 | my (@commands) = @_; | |
538 | ||
539 | print interruptrun(@commands) if (!opt('log')); | |
540 | $logfh->print(interruptrun(@commands)) if (opt('log')); | |
541 | } | |
542 | ||
543 | sub interruptrun | |
544 | { | |
545 | my (@commands) = @_; | |
546 | ||
547 | my $command = join('', @commands); | |
548 | local(*FD); | |
549 | my $pid = open(FD, "$command |"); | |
550 | my $text; | |
551 | ||
552 | local($SIG{HUP}) = sub { kill 9, $pid; exit }; | |
553 | local($SIG{INT}) = sub { kill 9, $pid; exit }; | |
554 | ||
555 | my $needalarm = | |
556 | ($ENV{PERLCC_TIMEOUT} && | |
557 | $Config{'osname'} ne 'MSWin32' && | |
558 | $command =~ m"(^|\s)perlcc\s"); | |
559 | ||
560 | eval | |
561 | { | |
562 | local($SIG{ALRM}) = sub { die "INFINITE LOOP"; }; | |
563 | alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm); | |
564 | $text = join('', <FD>); | |
565 | alarm(0) if ($needalarm); | |
566 | }; | |
567 | ||
568 | if ($@) | |
569 | { | |
570 | eval { kill 'HUP', $pid }; | |
571 | vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n"; | |
572 | } | |
573 | ||
574 | close(FD); | |
575 | return($text); | |
576 | } | |
577 | ||
b326da91 MB |
578 | sub is_win32() { $^O =~ m/^MSWin/ } |
579 | sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i } | |
580 | ||
e4f0d88d EP |
581 | END { |
582 | unlink $cfile if ($cfile && !opt(S) && !opt(c)); | |
583 | } | |
52cebf5e EP |
584 | |
585 | __END__ | |
586 | ||
587 | =head1 NAME | |
588 | ||
ecde9bf0 | 589 | perlcc - generate executables from Perl programs |
52cebf5e EP |
590 | |
591 | =head1 SYNOPSIS | |
592 | ||
ecde9bf0 SC |
593 | $ perlcc hello # Compiles into executable 'a.out' |
594 | $ perlcc -o hello hello.pl # Compiles into executable 'hello' | |
52cebf5e | 595 | |
ecde9bf0 SC |
596 | $ perlcc -O file # Compiles using the optimised C backend |
597 | $ perlcc -B file # Compiles using the bytecode backend | |
52cebf5e | 598 | |
ecde9bf0 SC |
599 | $ perlcc -c file # Creates a C file, 'file.c' |
600 | $ perlcc -S -o hello file # Creates a C file, 'file.c', | |
601 | # then compiles it to executable 'hello' | |
602 | $ perlcc -c out.c file # Creates a C file, 'out.c' from 'file' | |
52cebf5e | 603 | |
ecde9bf0 SC |
604 | $ perlcc -e 'print q//' # Compiles a one-liner into 'a.out' |
605 | $ perlcc -c -e 'print q//' # Creates a C file 'a.out.c' | |
e4f0d88d | 606 | |
f5eac215 JH |
607 | $ perlcc -I /foo hello # extra headers (notice the space after -I) |
608 | $ perlcc -L /foo hello # extra libraries (notice the space after -L) | |
e4f0d88d | 609 | |
f5eac215 | 610 | $ perlcc -r hello # compiles 'hello' into 'a.out', runs 'a.out'. |
e4f0d88d EP |
611 | $ perlcc -r hello a b c # compiles 'hello' into 'a.out', runs 'a.out'. |
612 | # with arguments 'a b c' | |
613 | ||
614 | $ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile | |
615 | # log into 'c'. | |
616 | ||
52cebf5e EP |
617 | =head1 DESCRIPTION |
618 | ||
ecde9bf0 SC |
619 | F<perlcc> creates standalone executables from Perl programs, using the |
620 | code generators provided by the L<B> module. At present, you may | |
621 | either create executable Perl bytecode, using the C<-B> option, or | |
622 | generate and compile C files using the standard and 'optimised' C | |
623 | backends. | |
52cebf5e | 624 | |
ecde9bf0 SC |
625 | The code generated in this way is not guaranteed to work. The whole |
626 | codegen suite (C<perlcc> included) should be considered B<very> | |
627 | experimental. Use for production purposes is strongly discouraged. | |
52cebf5e | 628 | |
ecde9bf0 | 629 | =head1 OPTIONS |
52cebf5e EP |
630 | |
631 | =over 4 | |
632 | ||
ecde9bf0 | 633 | =item -LI<library directories> |
52cebf5e | 634 | |
ecde9bf0 SC |
635 | Adds the given directories to the library search path when C code is |
636 | passed to your C compiler. | |
52cebf5e | 637 | |
ecde9bf0 | 638 | =item -II<include directories> |
52cebf5e | 639 | |
ecde9bf0 SC |
640 | Adds the given directories to the include file search path when C code is |
641 | passed to your C compiler; when using the Perl bytecode option, adds the | |
642 | given directories to Perl's include path. | |
9636a016 | 643 | |
ecde9bf0 | 644 | =item -o I<output file name> |
9636a016 | 645 | |
ecde9bf0 | 646 | Specifies the file name for the final compiled executable. |
9636a016 | 647 | |
ecde9bf0 | 648 | =item -c I<C file name> |
9636a016 | 649 | |
ecde9bf0 | 650 | Create C code only; do not compile to a standalone binary. |
52cebf5e | 651 | |
ecde9bf0 | 652 | =item -e I<perl code> |
52cebf5e | 653 | |
ecde9bf0 | 654 | Compile a one-liner, much the same as C<perl -e '...'> |
52cebf5e | 655 | |
ecde9bf0 | 656 | =item -S |
52cebf5e | 657 | |
ecde9bf0 | 658 | Do not delete generated C code after compilation. |
52cebf5e | 659 | |
ecde9bf0 | 660 | =item -B |
52cebf5e | 661 | |
ecde9bf0 | 662 | Use the Perl bytecode code generator. |
52cebf5e | 663 | |
ecde9bf0 | 664 | =item -O |
52cebf5e | 665 | |
ecde9bf0 SC |
666 | Use the 'optimised' C code generator. This is more experimental than |
667 | everything else put together, and the code created is not guaranteed to | |
668 | compile in finite time and memory, or indeed, at all. | |
52cebf5e | 669 | |
ecde9bf0 | 670 | =item -v |
52cebf5e | 671 | |
ecde9bf0 | 672 | Increase verbosity of output; can be repeated for more verbose output. |
52cebf5e | 673 | |
e4f0d88d EP |
674 | =item -r |
675 | ||
676 | Run the resulting compiled script after compiling it. | |
677 | ||
678 | =item -log | |
679 | ||
680 | Log the output of compiling to a file rather than to stdout. | |
681 | ||
52cebf5e EP |
682 | =back |
683 | ||
52cebf5e EP |
684 | =cut |
685 | ||
686 | !NO!SUBS! | |
687 | ||
688 | close OUT or die "Can't close $file: $!"; | |
689 | chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; | |
690 | exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; | |
8a5546a1 | 691 | chdir $origdir; |