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