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