4 use File::Basename qw(&basename &dirname);
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
13 # to ensure Configure will look for $Config{startperl}.
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.
20 $file = basename($0, '.PL');
21 $file .= '.com' if $^O eq 'VMS';
23 open OUT,">$file" or die "Can't create $file: $!";
25 print "Extracting $file (with variable substitutions)\n";
27 # In this section, perl variables will be expanded during extraction.
28 # You can use $Config{...} to use Configure variables.
30 print OUT <<"!GROK!THIS!";
32 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
33 if \$running_under_some_shell;
34 --\$running_under_some_shell;
37 # In the following, perl variables are not expanded during extraction.
39 print OUT <<'!NO!SUBS!';
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
44 # Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
45 # Version 2.04, Enache Adrian,Fri, 18 Jul 2003 23:15:37 +0300
53 use Fcntl qw(:DEFAULT :flock);
54 use File::Temp qw(tempfile);
59 $SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves.
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
66 sub opt(*); # imal quoting
70 our ($Options, $BinPerl, $Backend);
71 our ($Input => $Output);
74 our (@begin_output); # output from BEGIN {}, for testsuite
76 # eval { main(); 1 } or die;
86 _die("XXX: Not reached?");
89 #######################################################################
96 $Backend = 'Bytecode';
98 if (opt(S) && opt(c)) {
99 # die "$0: Do you want me to compile this or not?\n";
100 delete $Options->{S};
102 $Backend = 'CC' if opt(O);
108 vprint 0, "Compiling $Input";
110 $BinPerl = yclept(); # Calling convention for perl.
115 if ($Backend eq 'Bytecode') {
121 exit(0) if (!opt('r'));
125 vprint 0, "Running code";
126 run("$Output @ARGV");
130 # usage: vprint [level] msg args
135 } elsif ($_[0] =~ /^\d$/) {
138 # well, they forgot to use a number; means >0
142 $msg .= "\n" unless substr($msg, -1) eq "\n";
145 print "$0: $msg" if !opt('log');
146 print $logfh "$0: $msg" if opt('log');
154 # disallows using long arguments
155 # Getopt::Long::Configure("bundling");
157 Getopt::Long::Configure("no_ignore_case");
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};
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
168 'v:i', # Verbosity level
170 'r', # run resulting executable
171 'B', # Byte compiler backend
172 'O', # Optimised C backend
176 'r', # run the resulting executable
177 'T', # run the backend using perl -T
178 't', # run the backend using perl -t
179 'static', # Dirty hack to enable -shared/-static
180 'shared', # Create a shared library (--shared for compat.)
181 'log:s', # where to log compilation process information
182 'Wb:s', # pass (comma-sepearated) options to backend
183 'testsuite', # try to be nice to testsuite
188 if( opt(t) && opt(T) ) {
189 warn "Can't specify both -T and -t, -t ignored";
193 helpme() if opt(h); # And exit
195 $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' );
196 $Output = is_win32() ? $Output : relativize($Output);
197 $logfh = new FileHandle(">> " . opt('log')) if (opt('log'));
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!
203 $Input = is_win32() ? # Quotes eaten by shell
207 $Input = shift @ARGV; # XXX: more files?
208 _usage_and_die("$0: No input file specified\n") unless $Input;
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;
221 return exists($Options->{$opt}) && ($Options->{$opt} || 0);
225 die "$0: Compiling to shared libraries is currently disabled\n";
229 my $command = "$BinPerl -MO=Bytecode,-H,-o$Output $Input";
230 $Input =~ s/^-e.*$/-e/;
232 my ($output_r, $error_r) = spawnit($command);
234 if (@$error_r && $? != 0) {
235 _die("$0: $Input did not compile:\n@$error_r\n");
237 my @error = grep { !/^$Input syntax OK$/o } @$error_r;
238 warn "$0: Unexpected compiler output:\n@error" if @error;
241 chmod 0777 & ~umask, $Output or _die("can't chmod $Output: $!");
246 my $stash = grab_stash();
247 my $taint = opt(T) ? '-T' :
250 # What are we going to call our output C file?
254 my $addoptions = opt(Wb);
257 $addoptions .= ',' if $addoptions !~ m/,$/;
260 if (opt(testsuite)) {
261 my $bo = join '', @begin_output;
262 $bo =~ s/\\/\\\\\\\\/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 $!",};
271 if (opt(S) || opt(c)) {
272 # We need to keep it.
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;
281 $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
285 # Don't need to keep it, be safe with a tempfile.
287 ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c");
288 close $cfh; # See comment just below
290 vprint 1, "Writing C on $cfile";
292 my $max_line_len = '';
293 if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
294 $max_line_len = '-l2000,';
297 # This has to do the write itself, so we can't keep a lock. Life
299 my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input";
300 vprint 1, "Compiling...";
301 vprint 1, "Calling $command";
303 my ($output_r, $error_r) = spawnit($command);
304 my @output = @$output_r;
305 my @error = @$error_r;
307 if (@error && $? != 0) {
308 _die("$0: $Input did not compile, which can't happen:\n@error\n");
312 cc_harness_msvc($cfile,$stash) :
313 cc_harness($cfile,$stash) unless opt(c);
316 vprint 2, "unlinking $cfile";
317 unlink $cfile or _die("can't unlink $cfile: $!");
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);
331 $link .= " perl57.lib kernel32.lib msvcrt.lib";
332 vprint 3, "running $Config{cc} $compile";
333 system("$Config{cc} $compile");
334 vprint 3, "running $Config{ld} $link";
335 system("$Config{ld} $link");
339 my ($cfile,$stash)=@_;
340 use ExtUtils::Embed ();
341 my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
342 $command .= " -I".$_ for split /\s+/, opt(I);
343 $command .= " -L".$_ for split /\s+/, opt(L);
344 my @mods = split /-?u /, $stash;
345 $command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
346 $command .= " -lperl";
347 vprint 3, "running $Config{cc} $command";
348 system("$Config{cc} $command");
351 # Where Perl is, and which include path to give it.
353 my $command = "$^X ";
355 # DWIM the -I to be Perl, not C, include directories.
356 if (opt(I) && $Backend eq "Bytecode") {
357 for (split /\s+/, opt(I)) {
361 warn "$0: Include directory $_ not found, skipping\n";
366 $command .= "-I$_ " for @INC;
370 # Use B::Stash to find additional modules and stuff.
375 warn "already called get_stash once" if $_stash;
377 my $taint = opt(T) ? '-T' :
379 my $command = "$BinPerl $taint -MB::Stash -c $Input";
380 # Filename here is perfectly sanitised.
381 vprint 3, "Calling $command\n";
383 my ($stash_r, $error_r) = spawnit($command);
384 my @stash = @$stash_r;
385 my @error = @$error_r;
387 if (@error && $? != 0) {
388 _die("$0: $Input did not compile:\n@error\n");
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;
397 $stash[0] =~ s/,-u\<none\>//;
398 $stash[0] =~ s/^.*?-u/-u/s;
399 vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
401 return $_stash = $stash[0];
406 # Check the consistency of options if -B is selected.
407 # To wit, (-B|-O) ==> no -shared, no -S, no -c
410 _die("$0: Please choose one of either -B and -O.\n") if opt(O);
413 warn "$0: Will not create a shared library for bytecode\n";
414 delete $Options->{shared};
417 for my $o ( qw[c S] ) {
419 warn "$0: Compiling to bytecode is a one-pass process--",
421 delete $Options->{$o};
427 # Check the input and output files make sense, are read/writeable.
429 if ($Input eq $Output) {
430 if ($Input eq 'a.out') {
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.
434 warn "$0: Will not write output on top of input file, ",
435 "compiling to a.out instead\n";
444 _die("$0: Input file $file is a directory, not a file\n") if -d _;
446 _die("$0: Input file $file was not found\n");
448 _die("$0: Cannot read input file $file: $!\n");
452 # XXX: die? don't try this on /dev/tty
453 warn "$0: WARNING: input $file is not a plain file\n";
460 _die("$0: Cannot write on $file, is a directory\n");
463 _die("$0: Cannot write on $file: $!\n") unless -w _;
466 _die("$0: Cannot write in this directory: $!\n");
473 warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
474 print "Checking file type... ";
475 system("file", $file);
476 _die("Please try a perlier file!\n");
479 open(my $handle, "<", $file) or _die("XXX: can't open $file: $!");
480 local $_ = <$handle>;
481 if (/^#!/ && !/perl/) {
482 _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
487 # File spawning and error collecting
489 my ($command) = shift;
492 (undef, $errname) = tempfile("pccXXXXX");
494 open (S_OUT, "$command 2>$errname |")
495 or _die("$0: Couldn't spawn the compiler.\n");
498 open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
502 unlink $errname or _die("$0: Can't unlink error file $errname");
503 return (\@output, \@error);
507 print "perlcc compiler frontend, version $VERSION\n\n";
518 return() if ($args =~ m"^[/\\]");
523 $logfh->print(@_) if opt('log');
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.
532 $0 [-o executable] [-r] [-O|-B|-c|-S] [-log log] [source[.pl] | -e oneliner]
539 print interruptrun(@commands) if (!opt('log'));
540 $logfh->print(interruptrun(@commands)) if (opt('log'));
547 my $command = join('', @commands);
549 my $pid = open(FD, "$command |");
552 local($SIG{HUP}) = sub { kill 9, $pid; exit };
553 local($SIG{INT}) = sub { kill 9, $pid; exit };
556 ($ENV{PERLCC_TIMEOUT} &&
557 $Config{'osname'} ne 'MSWin32' &&
558 $command =~ m"(^|\s)perlcc\s");
562 local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
563 alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm);
564 $text = join('', <FD>);
565 alarm(0) if ($needalarm);
570 eval { kill 'HUP', $pid };
571 vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
578 sub is_win32() { $^O =~ m/^MSWin/ }
579 sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
582 unlink $cfile if ($cfile && !opt(S) && !opt(c));
589 perlcc - generate executables from Perl programs
593 $ perlcc hello # Compiles into executable 'a.out'
594 $ perlcc -o hello hello.pl # Compiles into executable 'hello'
596 $ perlcc -O file # Compiles using the optimised C backend
597 $ perlcc -B file # Compiles using the bytecode backend
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'
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'
607 $ perlcc -I /foo hello # extra headers (notice the space after -I)
608 $ perlcc -L /foo hello # extra libraries (notice the space after -L)
610 $ perlcc -r hello # compiles 'hello' into 'a.out', runs 'a.out'.
611 $ perlcc -r hello a b c # compiles 'hello' into 'a.out', runs 'a.out'.
612 # with arguments 'a b c'
614 $ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile
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
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.
633 =item -LI<library directories>
635 Adds the given directories to the library search path when C code is
636 passed to your C compiler.
638 =item -II<include directories>
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.
644 =item -o I<output file name>
646 Specifies the file name for the final compiled executable.
648 =item -c I<C file name>
650 Create C code only; do not compile to a standalone binary.
652 =item -e I<perl code>
654 Compile a one-liner, much the same as C<perl -e '...'>
658 Do not delete generated C code after compilation.
662 Use the Perl bytecode code generator.
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.
672 Increase verbosity of output; can be repeated for more verbose output.
676 Run the resulting compiled script after compiling it.
680 Log the output of compiling to a file rather than to stdout.
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 ':';