Commit | Line | Data |
52cebf5e |
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 |
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 |
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 |
35 | !GROK!THIS! |
36 | |
37 | # In the following, perl variables are not expanded during extraction. |
38 | |
39 | print OUT <<'!NO!SUBS!'; |
40 | |
ecde9bf0 |
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 |
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 |
59 | $SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves. |
60 | |
ecde9bf0 |
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 |
67 | sub is_win32(); |
68 | sub is_msvc(); |
52cebf5e |
69 | |
ecde9bf0 |
70 | our ($Options, $BinPerl, $Backend); |
71 | our ($Input => $Output); |
e4f0d88d |
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 |
77 | |
78 | main(); |
79 | |
e4f0d88d |
80 | sub main { |
ecde9bf0 |
81 | parse_argv(); |
82 | check_write($Output); |
83 | choose_backend(); |
84 | generate_code(); |
e4f0d88d |
85 | run_code(); |
86 | _die("XXX: Not reached?"); |
52cebf5e |
87 | } |
9636a016 |
88 | |
ecde9bf0 |
89 | ####################################################################### |
52cebf5e |
90 | |
ecde9bf0 |
91 | sub choose_backend { |
92 | # Choose the backend. |
93 | $Backend = 'C'; |
94 | if (opt(B)) { |
95 | checkopts_byte(); |
96 | $Backend = 'Bytecode'; |
52cebf5e |
97 | } |
ecde9bf0 |
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 |
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 |
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 |
121 | exit(0) if (!opt('r')); |
122 | } |
52cebf5e |
123 | |
e4f0d88d |
124 | sub run_code { |
125 | vprint 0, "Running code"; |
126 | run("$Output @ARGV"); |
127 | exit(0); |
52cebf5e |
128 | } |
129 | |
ecde9bf0 |
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 |
143 | if (opt(v) > $level) |
144 | { |
145 | print "$0: $msg" if !opt('log'); |
146 | print $logfh "$0: $msg" if opt('log'); |
147 | } |
148 | } |
ecde9bf0 |
149 | |
150 | sub parse_argv { |
151 | |
152 | use Getopt::Long; |
f5eac215 |
153 | |
154 | # disallows using long arguments |
155 | # Getopt::Long::Configure("bundling"); |
156 | |
ecde9bf0 |
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 |
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 |
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 |
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 |
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 |
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 |
203 | $Input = is_win32() ? # Quotes eaten by shell |
204 | '-e "'.opt(e).'"' : |
205 | "-e '".opt(e)."'"; |
ecde9bf0 |
206 | } else { |
207 | $Input = shift @ARGV; # XXX: more files? |
e4f0d88d |
208 | _usage_and_die("$0: No input file specified\n") unless $Input; |
ecde9bf0 |
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 |
215 | } |
216 | |
ecde9bf0 |
217 | } |
5268c7a4 |
218 | |
ecde9bf0 |
219 | sub opt(*) { |
220 | my $opt = shift; |
221 | return exists($Options->{$opt}) && ($Options->{$opt} || 0); |
222 | } |
52cebf5e |
223 | |
ecde9bf0 |
224 | sub compile_module { |
225 | die "$0: Compiling to shared libraries is currently disabled\n"; |
52cebf5e |
226 | } |
227 | |
ecde9bf0 |
228 | sub compile_byte { |
1df34986 |
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 |
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 |
245 | sub compile_cstyle { |
246 | my $stash = grab_stash(); |
b326da91 |
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 |
254 | my $addoptions = opt(Wb); |
255 | |
256 | if( $addoptions ) { |
257 | $addoptions .= ',' if $addoptions !~ m/,$/; |
258 | } |
b326da91 |
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 |
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 |
292 | my $max_line_len = ''; |
293 | if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) { |
294 | $max_line_len = '-l2000,'; |
295 | } |
52cebf5e |
296 | |
ecde9bf0 |
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 |
300 | vprint 1, "Compiling..."; |
301 | vprint 1, "Calling $command"; |
52cebf5e |
302 | |
ecde9bf0 |
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 |
311 | is_msvc ? |
312 | cc_harness_msvc($cfile,$stash) : |
313 | cc_harness($cfile,$stash) unless opt(c); |
52cebf5e |
314 | |
ecde9bf0 |
315 | if ($lose) { |
316 | vprint 2, "unlinking $cfile"; |
e4f0d88d |
317 | unlink $cfile or _die("can't unlink $cfile: $!"); |
ecde9bf0 |
318 | } |
52cebf5e |
319 | } |
320 | |
b326da91 |
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 |
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 |
338 | sub cc_harness { |
339 | my ($cfile,$stash)=@_; |
340 | use ExtUtils::Embed (); |
341 | my $command = ExtUtils::Embed::ccopts." -o $Output $cfile "; |
3af308c7 |
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 |
347 | vprint 3, "running $Config{cc} $command"; |
348 | system("$Config{cc} $command"); |
52cebf5e |
349 | } |
350 | |
ecde9bf0 |
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 |
363 | } |
364 | } |
ecde9bf0 |
365 | |
366 | $command .= "-I$_ " for @INC; |
367 | return $command; |
52cebf5e |
368 | } |
369 | |
ecde9bf0 |
370 | # Use B::Stash to find additional modules and stuff. |
52cebf5e |
371 | { |
ecde9bf0 |
372 | my $_stash; |
373 | sub grab_stash { |
52cebf5e |
374 | |
ecde9bf0 |
375 | warn "already called get_stash once" if $_stash; |
52cebf5e |
376 | |
b326da91 |
377 | my $taint = opt(T) ? '-T' : |
378 | opt(t) ? '-t' : ''; |
379 | my $command = "$BinPerl $taint -MB::Stash -c $Input"; |
ecde9bf0 |
380 | # Filename here is perfectly sanitised. |
381 | vprint 3, "Calling $command\n"; |
9636a016 |
382 | |
ecde9bf0 |
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 |
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 |
399 | vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0]; |
400 | chomp $stash[0]; |
401 | return $_stash = $stash[0]; |
52cebf5e |
402 | } |
403 | |
ecde9bf0 |
404 | } |
52cebf5e |
405 | |
ecde9bf0 |
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 |
412 | if (opt(shared)) { |
413 | warn "$0: Will not create a shared library for bytecode\n"; |
414 | delete $Options->{shared}; |
415 | } |
52cebf5e |
416 | |
ecde9bf0 |
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 |
423 | } |
424 | |
52cebf5e |
425 | } |
426 | |
ecde9bf0 |
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 |
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 |
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 |
438 | } |
439 | } |
440 | |
ecde9bf0 |
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 |
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 |
455 | } |
456 | |
ecde9bf0 |
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 |
461 | } |
462 | if (-e _) { |
e4f0d88d |
463 | _die("$0: Cannot write on $file: $!\n") unless -w _; |
ecde9bf0 |
464 | } |
465 | unless (-w cwd()) { |
e4f0d88d |
466 | _die("$0: Cannot write in this directory: $!\n"); |
ef712cf7 |
467 | } |
ef712cf7 |
468 | } |
469 | |
ecde9bf0 |
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 |
477 | } |
478 | |
e4f0d88d |
479 | open(my $handle, "<", $file) or _die("XXX: can't open $file: $!"); |
ecde9bf0 |
480 | local $_ = <$handle>; |
481 | if (/^#!/ && !/perl/) { |
e4f0d88d |
482 | _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n"); |
ecde9bf0 |
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 |
496 | @output = <S_OUT>; |
497 | } |
e4f0d88d |
498 | open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n"); |
ecde9bf0 |
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 |
503 | return (\@output, \@error); |
504 | } |
52cebf5e |
505 | |
ecde9bf0 |
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 |
513 | } |
514 | |
e4f0d88d |
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 |
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 |
578 | sub is_win32() { $^O =~ m/^MSWin/ } |
579 | sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i } |
580 | |
e4f0d88d |
581 | END { |
582 | unlink $cfile if ($cfile && !opt(S) && !opt(c)); |
583 | } |
52cebf5e |
584 | |
585 | __END__ |
586 | |
587 | =head1 NAME |
588 | |
ecde9bf0 |
589 | perlcc - generate executables from Perl programs |
52cebf5e |
590 | |
591 | =head1 SYNOPSIS |
592 | |
ecde9bf0 |
593 | $ perlcc hello # Compiles into executable 'a.out' |
594 | $ perlcc -o hello hello.pl # Compiles into executable 'hello' |
52cebf5e |
595 | |
ecde9bf0 |
596 | $ perlcc -O file # Compiles using the optimised C backend |
597 | $ perlcc -B file # Compiles using the bytecode backend |
52cebf5e |
598 | |
ecde9bf0 |
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 |
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 |
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 |
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 |
617 | =head1 DESCRIPTION |
618 | |
ecde9bf0 |
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 |
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 |
630 | |
631 | =over 4 |
632 | |
ecde9bf0 |
633 | =item -LI<library directories> |
52cebf5e |
634 | |
ecde9bf0 |
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 |
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 |
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 |
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 |
682 | =back |
683 | |
52cebf5e |
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; |