This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
87ec16c4eb1a9d846870e6f2ec86a2fa67144fa4
[perl5.git] / utils / perlcc.PL
1 #!/usr/local/bin/perl
2  
3 use Config;
4 use File::Basename qw(&basename &dirname);
5 use Cwd;
6  
7 # List explicitly here the variables you want Configure to
8 # generate.  Metaconfig only looks for shell variables, so you
9 # have to mention them as if they were shell variables, not
10 # %Config entries.  Thus you write
11 #  $startperl
12 # to ensure Configure will look for $Config{startperl}.
13 # Wanted:  $archlibexp
14  
15 # This forces PL files to create target in same directory as PL file.
16 # This is so that make depend always knows where to find PL derivatives.
17 $origdir = cwd;
18 chdir dirname($0);
19 $file = basename($0, '.PL');
20 $file .= '.com' if $^O eq 'VMS';
21  
22 open OUT,">$file" or die "Can't create $file: $!";
23  
24 print "Extracting $file (with variable substitutions)\n";
25  
26 # In this section, perl variables will be expanded during extraction.
27 # You can use $Config{...} to use Configure variables.
28  
29 print OUT <<"!GROK!THIS!";
30 $Config{startperl}
31     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
32     if \$running_under_some_shell;
33 !GROK!THIS!
34  
35 # In the following, perl variables are not expanded during extraction.
36  
37 print OUT <<'!NO!SUBS!';
38
39 use Config;
40 use strict;
41 use FileHandle;
42 use File::Basename qw(&basename &dirname);
43 use Cwd;
44
45 use Getopt::Long;
46
47 $Getopt::Long::bundling_override = 1;
48 $Getopt::Long::passthrough = 0;
49 $Getopt::Long::ignore_case = 0;
50
51 my $pathsep = ($Config{'osname'} eq 'MSWin32')? "\\" : "/"; # MAJOR HACK. SHOULD
52                                                             # BE IN Config.pm
53
54 my $options = {};
55 my $_fh;
56
57 main();
58
59 sub main
60 {
61
62     GetOptions
63             (
64             $options,   "L:s",
65                         "I:s",
66                         "C:s",
67                         "o:s",
68                         "e:s",
69                         "regex:s",
70                         "verbose:s",
71                         "log:s",
72                                                 "argv:s",
73                         "gen",
74                         "sav",
75                         "run",
76                         "prog",
77                         "mod"
78             );
79
80
81     my $key;
82
83     local($") = "|";
84
85     _usage() if (!_checkopts());
86     push(@ARGV, _maketempfile()) if ($options->{'e'});
87
88     _usage() if (!@ARGV);
89                 
90     my $file;
91     foreach $file (@ARGV)
92     {
93         _print("
94 --------------------------------------------------------------------------------
95 Compiling $file:
96 --------------------------------------------------------------------------------
97 ", 36 );
98         _doit($file);
99     }
100 }
101         
102 sub _doit
103 {
104     my ($file) = @_;
105
106     my ($program_ext, $module_ext) = _getRegexps();
107     my ($obj, $objfile, $so, $type);
108
109     if  (
110             (($file =~ m"@$program_ext") && ($file !~ m"@$module_ext"))
111             || (defined($options->{'prog'}) || defined($options->{'run'}))
112         )
113     {
114         $objfile = ($options->{'C'}) ?     $options->{'C'} : "$file.c";
115         $type = 'program';
116
117         $obj =         ($options->{'o'})?     $options->{'o'} : 
118                                             _getExecutable( $file,$program_ext);
119
120         return() if (!$obj);
121
122     }
123     elsif (($file =~ m"@$module_ext") || ($options->{'mod'}))
124     {
125         die "Shared objects are not supported on Win32 yet!!!!\n"
126                                       if ($Config{'osname'} eq 'MSWin32');
127
128         $obj =         ($options->{'o'})?    $options->{'o'} :
129                                             _getExecutable($file, $module_ext);
130         $so = "$obj.$Config{so}";
131         $type = 'sharedlib';
132         return() if (!$obj);
133         $objfile = ($options->{'C'}) ?     $options->{'C'} : "$file.c";
134     }
135     else
136     {
137         _error("noextension", $file, $program_ext, $module_ext);
138         return();
139     }
140
141     if ($type eq 'program')
142     {
143         _print("Making C($objfile) for $file!\n", 36 );
144
145         my $errcode = _createCode($objfile, $file);
146         (_print( "ERROR: In generating code for $file!\n", -1), return()) 
147                                                                 if ($errcode);
148
149         _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'});
150         $errcode = _compileCode($file, $objfile, $obj) 
151                                             if (!$options->{'gen'});
152
153         if ($errcode)
154                 {
155                         _print( "ERROR: In compiling code for $objfile !\n", -1);
156                         my $ofile = File::Basename::basename($objfile);
157                         $ofile =~ s"\.c$"\.o"s;
158                         
159                         _removeCode("$ofile"); 
160                         return()
161                 }
162     
163         _runCode($obj) if ($options->{'run'});
164
165         _removeCode($objfile) if (!$options->{'sav'} || 
166                                     ($options->{'e'} && !$options->{'C'}));
167
168         _removeCode($file) if ($options->{'e'}); 
169
170         _removeCode($obj) if (($options->{'e'}
171                                && !$options->{'sav'}
172                                && !$options->{'o'})
173                               || ($options->{'run'} && !$options->{'sav'}));
174     }
175     else
176     {
177         _print( "Making C($objfile) for $file!\n", 36 );
178         my $errcode = _createCode($objfile, $file, $obj);
179         (_print( "ERROR: In generating code for $file!\n", -1), return()) 
180                                                                 if ($errcode);
181     
182         _print( "Compiling C($so) for $file!\n", 36 ) if (!$options->{'gen'});
183
184         my $errorcode = 
185             _compileCode($file, $objfile, $obj, $so ) if (!$options->{'gen'});
186
187         (_print( "ERROR: In compiling code for $objfile!\n", -1), return()) 
188                                                                 if ($errcode);
189     }
190 }
191
192 sub _getExecutable
193 {
194     my ($sourceprog, $ext) = @_;
195     my ($obj);
196
197     if (defined($options->{'regex'}))
198     {
199         eval("(\$obj = \$sourceprog) =~ $options->{'regex'}");
200         return(0) if (_error('badeval', $@));
201         return(0) if (_error('equal', $obj, $sourceprog));
202     }
203     elsif (defined ($options->{'ext'}))
204     {
205         ($obj = $sourceprog) =~ s"@$ext"$options->{ext}"g;        
206         return(0) if (_error('equal', $obj, $sourceprog));
207     }
208     elsif (defined ($options->{'run'}))
209     {
210             $obj = "perlc$$";
211     }
212     else
213     {
214         ($obj = $sourceprog) =~ s"@$ext""g;
215         return(0) if (_error('equal', $obj, $sourceprog));
216     }
217     return($obj);
218 }
219
220 sub _createCode
221 {
222     my ( $generated_cfile, $file, $final_output ) = @_;
223     my $return;
224
225     local($") = " -I";
226
227     if (@_ == 2)                                   # compiling a program   
228     {
229         _print( "$^X -I@INC -MB::Stash -c  $file\n", 36);
230         my $stash=`$^X -I@INC -MB::Stash -c  $file 2>/dev/null|tail -1`;
231         chomp $stash;
232
233         _print( "$^X -I@INC -MO=CC,$stash,-o$generated_cfile $file\n", 36);
234         $return =  _run("$^X -I@INC -MO=CC,$stash,-o$generated_cfile $file", 9);
235         $return;
236     }
237     else                                           # compiling a shared object
238     {            
239         _print( 
240             "$^X -I@INC -MO=CC,-m$final_output,-o$generated_cfile $file\n", 36);
241         $return = 
242         _run("$^X -I@INC -MO=CC,-m$final_output,-o$generated_cfile $file", 9);
243         $return;
244     }
245 }
246
247 sub _compileCode
248 {
249     my ($sourceprog, $generated_cfile, $output_executable, $shared_object) = @_;
250     my @return;
251
252     if (@_ == 3)                            # just compiling a program 
253     {
254         $return[0] = 
255         _ccharness('static', $sourceprog, "-o", $output_executable,
256                    $generated_cfile);  
257         $return[0];
258     }
259     else
260     {
261         my $object_file = $generated_cfile;
262         $object_file =~ s"\.c$"$Config{_o}";   
263
264         $return[0] = _ccharness('compile', $sourceprog, "-c", $generated_cfile);
265         $return[1] = _ccharness
266                             (
267                                 'dynamic', 
268                                 $sourceprog, "-o", 
269                                 $shared_object, $object_file 
270                             );
271         return(1) if (grep ($_, @return));
272         return(0);
273     }
274 }
275
276 sub _runCode
277 {
278     my ($executable) = @_;
279     _print("$executable $options->{'argv'}\n", 36);
280     _run("$executable $options->{'argv'}", -1 );
281 }
282
283 sub _removeCode
284 {
285     my ($file) = @_;
286     unlink($file) if (-e $file);
287 }
288
289 sub _ccharness
290 {
291     my $type = shift;
292     my (@args) = @_;
293     local($") = " ";
294
295     my $sourceprog = shift(@args);
296     my ($libdir, $incdir);
297
298     if (-d "$Config{installarchlib}/CORE")
299     {
300         $libdir = "-L$Config{installarchlib}/CORE";
301         $incdir = "-I$Config{installarchlib}/CORE";
302     }
303     else
304     {
305         $libdir = "-L.. -L."; 
306         $incdir = "-I.. -I.";
307     }
308
309     $libdir .= " -L$options->{L}" if (defined($options->{L}));
310     $incdir .= " -I$options->{L}" if (defined($options->{L}));
311
312     my $linkargs = '';
313     my $dynaloader = '';
314     my $optimize = '';
315     my $flags = '';
316
317     if (!grep(/^-[cS]$/, @args))
318     {
319         my $lperl = $^O eq 'os2' ? '-llibperl' 
320            : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\perl.lib"
321            : '-lperl';
322
323         $optimize = $Config{'optimize'} =~ /-O\d/ ? '' : $Config{'optimize'};
324
325         $flags = $type eq 'dynamic' ? $Config{lddlflags} : $Config{ldflags};
326         $linkargs = "$flags $libdir $lperl @Config{libs}";
327     }
328
329     my $libs = _getSharedObjects($sourceprog);
330
331     my $cccmd = "$Config{cc} $Config{ccflags} $optimize $incdir "
332                 ."@args $dynaloader $linkargs @$libs";
333
334     _print ("$cccmd\n", 36);
335     _run("$cccmd", 18 );
336 }
337
338 sub _getSharedObjects
339 {
340     my ($sourceprog) = @_;
341     my ($tmpfile, $incfile);
342     my (@sharedobjects, @libraries);
343     local($") = " -I";
344
345     my ($tmpprog);
346     ($tmpprog = $sourceprog) =~ s"(.*)[\\/](.*)"$2";
347
348     my $tempdir;
349
350     if ($Config{'osname'} eq 'MSWin32') 
351     { 
352          $tempdir = $ENV{TEMP};
353          $tempdir =~ s[\\][/]g;
354     }
355     else
356     {
357          $tempdir = "/tmp";
358     }
359     $tmpfile = "$tempdir/$tmpprog.tst";
360     $incfile = "$tempdir/$tmpprog.val";
361
362     my $fd = new FileHandle("> $tmpfile") || die "Couldn't open $tmpfile!\n";
363     my $fd2 = 
364         new FileHandle("$sourceprog") || die "Couldn't open $sourceprog!\n";
365
366     print $fd <<"EOF";
367         use FileHandle;
368         my \$fh3  = new FileHandle("> $incfile") 
369                                         || die "Couldn't open $incfile\\n";
370
371         my \$key;
372         foreach \$key (keys(\%INC)) { print \$fh3 "\$key:\$INC{\$key}\\n"; }
373         close(\$fh3);
374         exit();
375 EOF
376
377     print $fd (   <$fd2>    );
378     close($fd);
379
380     _print("$^X -I@INC $tmpfile\n", 36);
381     _run("$^X -I@INC $tmpfile", 9 );
382
383     $fd = new FileHandle ("$incfile"); 
384     my @lines = <$fd>;    
385
386     unlink($tmpfile);
387     unlink($incfile);
388
389     my $line;
390     my $autolib;
391
392     my @return;
393
394     foreach $line (@lines) 
395     {
396         chomp($line);
397
398         my ($modname, $modpath) = split(':', $line);
399         my ($dir, $file) = ($modpath=~ m"(.*)[\\/]($modname)");
400
401         if ($autolib = _lookforAuto($dir, $file)) { push(@return, $autolib); }
402     }
403     return(\@return);
404 }
405
406 sub _maketempfile
407 {
408     my $return;
409
410 #    if ($Config{'osname'} eq 'MSWin32') 
411 #            { $return = "C:\\TEMP\\comp$$.p"; }
412 #    else
413 #            { $return = "/tmp/comp$$.p"; }
414
415     $return = "comp$$.p"; 
416
417     my $fd = new FileHandle( "> $return") || die "Couldn't open $return!\n";
418     print $fd $options->{'e'};
419     close($fd);
420
421     return($return);
422 }
423     
424     
425 sub _lookforAuto
426 {
427     my ($dir, $file) = @_;    
428
429     my ($relabs, $relshared);
430     my ($prefix);
431     my $return;
432
433     ($prefix = $file) =~ s"(.*)\.pm"$1";
434
435     my ($tmp, $modname) = ($prefix =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
436
437     $relshared = "$pathsep$prefix$pathsep$modname.$Config{so}";
438     $relabs    = "$pathsep$prefix$pathsep$modname$Config{_a}";
439                                                # HACK . WHY DOES _a HAVE A '.'
440                                                # AND so HAVE NONE??
441
442     my @searchpaths =   map("$_${pathsep}auto", @INC);
443     
444     my $path;
445     foreach $path (@searchpaths)
446     {
447         if (-e ($return = "$path$relshared")) { return($return); } 
448         if (-e ($return = "$path$relabs"))    { return($return); }
449     }
450    return(undef);
451 }
452
453 sub _getRegexps    # make the appropriate regexps for making executables, 
454 {                  # shared libs
455
456     my ($program_ext, $module_ext) = ([],[]); 
457
458
459     @$program_ext = ($ENV{PERL_SCRIPT_EXT})? split(':', $ENV{PERL_SCRIPT_EXT}) :
460                                             ('.p$', '.pl$', '.bat$');
461
462
463     @$module_ext  = ($ENV{PERL_MODULE_EXT})? split(':', $ENV{PERL_MODULE_EXT}) :
464                                             ('.pm$');
465
466     _mungeRegexp( $program_ext );
467     _mungeRegexp( $module_ext  );    
468
469     return($program_ext, $module_ext);
470 }
471
472 sub _mungeRegexp
473 {
474     my ($regexp) = @_;
475
476     grep(s:(^|[^\\])\.:$1\x00\\.:g, @$regexp);
477     grep(s:(^|[^\x00])\\\.:$1\.:g,  @$regexp);
478     grep(s:\x00::g,                 @$regexp);
479 }
480
481 sub _error
482 {
483     my ($type, @args) = @_;
484
485     if ($type eq 'equal')
486     {
487             
488         if ($args[0] eq $args[1])
489         {
490             _print ("ERROR: The object file '$args[0]' does not generate a legitimate executable file! Skipping!\n", -1);
491             return(1);
492         }
493     }
494     elsif ($type eq 'badeval')
495     {
496         if ($args[0])
497         {
498             _print ("ERROR: $args[0]\n", -1);
499             return(1);
500         }
501     }
502     elsif ($type eq 'noextension')
503     {
504         my $progext = join(',', @{$args[1]});
505         my $modext  = join(',', @{$args[2]});
506
507         $progext =~ s"\\""g;
508         $modext  =~ s"\\""g;
509
510         $progext =~ s"\$""g;
511         $modext  =~ s"\$""g;
512
513         _print 
514         (
515 "
516 ERROR: '$args[0]' does not have a proper extension! Proper extensions are:
517
518     PROGRAM:       $progext 
519     SHARED OBJECT: $modext
520
521 Use the '-prog' flag to force your files to be interpreted as programs.
522 Use the '-mod' flag to force your files to be interpreted as modules.
523 ", -1
524         );
525         return(1);
526     }
527
528     return(0);
529 }
530
531 sub _checkopts
532 {
533     my @errors;
534     local($") = "\n";
535
536     if ($options->{'log'})
537     {
538         $_fh = new FileHandle(">> $options->{'log'}") || push(@errors, "ERROR: Couldn't open $options->{'log'}\n");
539     }
540
541     if (($options->{'c'}) && (@ARGV > 1) && ($options->{'sav'} ))
542     {
543         push(@errors, 
544 "ERROR: The '-sav' and '-C' options are incompatible when you have more than 
545        one input file! ('-C' explicitly names resulting C code, '-sav' saves it,
546        and hence, with more than one file, the c code will be overwritten for 
547        each file that you compile)\n");
548     }
549     if (($options->{'o'}) && (@ARGV > 1))
550     {
551         push(@errors, 
552 "ERROR: The '-o' option is incompatible when you have more than one input file! 
553        (-o explicitly names the resulting executable, hence, with more than 
554        one file the names clash)\n");
555     }
556
557     if ($options->{'e'} && $options->{'sav'} && !$options->{'o'} && 
558                                                             !$options->{'C'})
559     {
560         push(@errors, 
561 "ERROR: You need to specify where you are going to save the resulting 
562        executable or C code,  when using '-sav' and '-e'. Use '-o' or '-C'.\n");
563     }
564
565     if (($options->{'regex'} || $options->{'run'} || $options->{'o'}) 
566                                                     && $options->{'gen'})
567     {
568         push(@errors, 
569 "ERROR: The options '-regex', '-run', and '-o' are incompatible with '-gen'. 
570        '-gen' says to stop at C generation, and the other three modify the 
571        compilation and/or running process!\n");
572     }
573
574     if ($options->{'run'} && $options->{'mod'})
575     {
576         push(@errors, 
577 "ERROR: Can't run modules that you are compiling! '-run' and '-mod' are 
578        incompatible!\n"); 
579     }
580
581     if ($options->{'e'} && @ARGV)
582     {
583         push (@errors, 
584 "ERROR: The option '-e' needs to be all by itself without any other 
585        file arguments!\n");
586     }
587     if ($options->{'e'} && !($options->{'o'} || $options->{'run'}))
588     {
589         $options->{'run'} = 1;
590     }
591
592     if (!defined($options->{'verbose'})) 
593     { 
594         $options->{'verbose'} = ($options->{'log'})? 64 : 7; 
595     }
596
597     my $verbose_error;
598
599     if ($options->{'verbose'} =~ m"[^tagfcd]" && 
600             !( $options->{'verbose'} eq '0' || 
601                 ($options->{'verbose'} < 64 && $options->{'verbose'} > 0)))
602     {
603         $verbose_error = 1;
604         push(@errors, 
605 "ERROR: Illegal verbosity level.  Needs to have either the letters 
606        't','a','g','f','c', or 'd' in it or be between 0 and 63, inclusive.\n");
607     }
608
609     $options->{'verbose'} = ($options->{'verbose'} =~ m"[tagfcd]")? 
610                             ($options->{'verbose'} =~ m"d") * 32 +     
611                             ($options->{'verbose'} =~ m"c") * 16 +     
612                             ($options->{'verbose'} =~ m"f") * 8     +     
613                             ($options->{'verbose'} =~ m"t") * 4     +     
614                             ($options->{'verbose'} =~ m"a") * 2     +     
615                             ($options->{'verbose'} =~ m"g") * 1     
616                                                     : $options->{'verbose'};
617
618     if     (!$verbose_error && (    $options->{'log'} && 
619                                 !(
620                                     ($options->{'verbose'} & 8)   || 
621                                     ($options->{'verbose'} & 16)  || 
622                                     ($options->{'verbose'} & 32 ) 
623                                 )
624                             )
625         )
626     {
627         push(@errors, 
628 "ERROR: The verbosity level '$options->{'verbose'}' does not output anything 
629        to a logfile, and you specified '-log'!\n");
630     } # }
631
632     if     (!$verbose_error && (    !$options->{'log'} && 
633                                 (
634                                     ($options->{'verbose'} & 8)   || 
635                                     ($options->{'verbose'} & 16)  || 
636                                     ($options->{'verbose'} & 32)  || 
637                                     ($options->{'verbose'} & 64)
638                                 )
639                             )
640         )
641     {
642         push(@errors, 
643 "ERROR: The verbosity level '$options->{'verbose'}' requires that you also 
644        specify a logfile via '-log'\n");
645     } # }
646
647
648     (_print( "\n". join("\n", @errors), -1), return(0)) if (@errors);
649     return(1);
650 }
651
652 sub _print
653 {
654     my ($text, $flag ) = @_;
655     
656     my $logflag = int($flag/8) * 8;
657     my $regflag = $flag % 8;
658
659     if ($flag == -1 || ($flag & $options->{'verbose'}))
660     {
661         my $dolog = ((($logflag & $options->{'verbose'}) || $flag == -1) 
662                                                         && $options->{'log'}); 
663
664         my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
665         
666         if ($doreg) { print( STDERR $text ); }
667         if ($dolog) { print $_fh $text; }
668     }
669 }
670
671 sub _run
672 {
673     my ($command, $flag) = @_;
674
675     my $logflag = ($flag != -1)? int($flag/8) * 8 : 0;
676     my $regflag = $flag % 8;
677
678     if ($flag == -1 || ($flag & $options->{'verbose'}))
679     {
680         my $dolog = ($logflag & $options->{'verbose'} && $options->{'log'});
681         my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
682
683         if ($doreg && !$dolog) 
684         {
685             print _interruptrun("$command");
686         }
687         elsif ($doreg && $dolog) 
688         { 
689             my $text = _interruptrun($command); 
690             print $_fh $text; 
691             print STDERR $text;
692         }
693         else 
694         { 
695             my $text = _interruptrun($command);
696             print $_fh $text; 
697         }
698     }
699     else 
700     {
701         _interruptrun($command);
702     }
703     return($?);
704 }
705
706 sub _interruptrun
707 {
708     my ($command) = @_;
709     my $pid = open (FD, "$command 2>&1 |");
710
711     local($SIG{HUP}) = sub { 
712 #       kill 9, $pid + 1;  
713 #       HACK... 2>&1 doesn't propogate
714 #       kill, comment out for quick and dirty
715 #       process killing of child.
716
717         kill 9, $pid;  
718         exit(); 
719     };
720     local($SIG{INT}) = sub { 
721 #       kill 9, $pid + 1;  
722 #       HACK... 2>&1 doesn't propogate
723 #       kill, comment out for quick and dirty
724 #       process killing of child.
725         kill 9, $pid; 
726         exit(); 
727     }; 
728
729     my $needalarm = 
730             ($ENV{'COMPILE_TIMEOUT'} && 
731                     $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc");
732     my $text;
733
734     eval
735     {
736         local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
737         alarm($ENV{'COMPILE_TIMEOUT'}) if ($needalarm);
738         $text = join('', <FD>); 
739         alarm(0) if ($needalarm);
740     };
741
742     if ($@) 
743     { 
744         eval { kill 'HUP', $pid; };
745         _print("SYSTEM TIMEOUT (infinite loop?)\n", 36); 
746     }
747         
748     close(FD);
749     return($text);
750 }
751
752 sub _usage
753 {
754     _print
755     ( 
756     <<"EOF"
757
758 Usage: $0 <file_list> 
759
760     Flags with arguments
761         -L       < extra library dirs for installation (form of 'dir1:dir2') >
762         -I       < extra include dirs for installation (form of 'dir1:dir2') >
763         -C       < explicit name of resulting C code > 
764         -o       < explicit name of resulting executable >
765         -e       < to compile 'one liners'. Need executable name (-o) or '-run'>
766         -regex   < rename regex, -regex 's/\.p/\.exe/' compiles a.p to a.exe >
767         -verbose < verbose level < 1-63, or following letters 'gatfcd' >
768         -argv    < arguments for the executables to be run via '-run' or '-e' > 
769
770     Boolean flags
771         -gen     ( to just generate the c code. Implies '-sav' )
772         -sav     ( to save intermediate c code, (and executables with '-run'))
773         -run     ( to run the compiled program on the fly, as were interpreted.)
774         -prog    ( to indicate that the files on command line are programs )
775         -mod     ( to indicate that the files on command line are modules  )
776
777 EOF
778 , -1
779
780     );
781     exit(255);
782 }
783
784
785 __END__
786
787 =head1 NAME
788
789 perlcc - frontend for perl compiler
790
791 =head1 SYNOPSIS
792
793     %prompt  perlcc a.p        # compiles into executable 'a'
794
795     %prompt  perlcc A.pm       # compile into 'A.so'
796
797     %prompt  perlcc a.p -o execute  # compiles 'a.p' into 'execute'.
798
799     %prompt  perlcc a.p -o execute -run # compiles 'a.p' into execute, runs on
800                                         # the fly
801
802     %prompt  perlcc a.p -o execute -run -argv 'arg1 arg2 arg3' 
803                                         # compiles into execute, runs with 
804                                         # arg1 arg2 arg3 as @ARGV
805
806     %prompt perlcc a.p b.p c.p -regex 's/\.p/\.exe'
807                                         # compiles into 'a.exe','b.exe','c.exe'.
808
809     %prompt perlcc a.p -log compilelog  # compiles into 'a', saves compilation
810                                         # info into compilelog, as well
811                                         # as mirroring to screen
812
813     %prompt perlcc a.p -log compilelog -verbose cdf 
814                                         # compiles into 'a', saves compilation
815                                         # info into compilelog, being silent
816                                         # on screen.
817
818     %prompt perlcc a.p -C a.c -gen      # generates C code (into a.c) and 
819                                         # stops without compile.
820
821     %prompt perlcc a.p -L ../lib a.c 
822                                         # Compiles with the perl libraries 
823                                         # inside ../lib included.
824
825 =head1 DESCRIPTION
826
827 'perlcc' is the frontend into the perl compiler. Typing 'perlcc a.p'
828 compiles the code inside a.p into a standalone executable, and 
829 perlcc A.pm will compile into a shared object, A.so, suitable for inclusion 
830 into a perl program via "use A".
831
832 There are quite a few flags to perlcc which help with such issues as compiling 
833 programs in bulk, testing compiled programs for compatibility with the 
834 interpreter, and controlling.
835
836 =head1 OPTIONS 
837
838 =over 4
839
840 =item -L < library_directories >
841
842 Adds directories in B<library_directories> to the compilation command.
843
844 =item -I  < include_directories > 
845
846 Adds directories inside B<include_directories> to the compilation command.
847
848 =item -C   < c_code_name > 
849
850 Explicitly gives the name B<c_code_name> to the generated c code which is to 
851 be compiled. Can only be used if compiling one file on the command line.
852
853 =item -o   < executable_name >
854
855 Explicitly gives the name B<executable_name> to the executable which is to be
856 compiled. Can only be used if compiling one file on the command line.
857
858 =item -e   < perl_line_to_execute>
859
860 Compiles 'one liners', in the same way that B<perl -e> runs text strings at 
861 the command line. Default is to have the 'one liner' be compiled, and run all
862 in one go (see B<-run>); giving the B<-o> flag saves the resultant executable, 
863 rather than throwing it away. Use '-argv' to pass arguments to the executable
864 created.
865
866 =item -regex   <rename_regex>
867
868 Gives a rule B<rename_regex> - which is a legal perl regular expression - to 
869 create executable file names.
870
871 =item -verbose <verbose_level>
872
873 Show exactly what steps perlcc is taking to compile your code. You can
874 change the verbosity level B<verbose_level> much in the same way that
875 the C<-D> switch changes perl's debugging level, by giving either a
876 number which is the sum of bits you want or a list of letters
877 representing what you wish to see. Here are the verbosity levels so
878 far :
879
880     Bit 1(g):      Code Generation Errors to STDERR
881     Bit 2(a):      Compilation Errors to STDERR
882     Bit 4(t):      Descriptive text to STDERR 
883     Bit 8(f):      Code Generation Errors to file (B<-log> flag needed)
884     Bit 16(c):     Compilation Errors to file (B<-log> flag needed)
885     Bit 32(d):     Descriptive text to file (B<-log> flag needed) 
886
887 If the B<-log> tag is given, the default verbose level is 63 (ie: mirroring 
888 all of perlcc's output to both the screen and to a log file). If no B<-log>
889 tag is given, then the default verbose level is 7 (ie: outputting all of 
890 perlcc's output to STDERR).
891
892 NOTE: Because of buffering concerns, you CANNOT shadow the output of '-run' to
893 both a file, and to the screen! Suggestions are welcome on how to overcome this
894 difficulty, but for now it simply does not work properly, and hence will only go
895 to the screen.
896
897 =item -log <logname>
898
899 Opens, for append, a logfile to save some or all of the text for a given 
900 compile command. No rewrite version is available, so this needs to be done 
901 manually.
902
903 =item -argv <arguments>
904
905 In combination with C<-run> or C<-e>, tells perlcc to run the resulting 
906 executable with the string B<arguments> as @ARGV.
907
908 =item -sav
909
910 Tells perl to save the intermediate C code. Usually, this C code is the name
911 of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
912 for example. If used with the C<-e> operator, you need to tell perlcc where to 
913 save resulting executables.
914
915 =item -gen
916
917 Tells perlcc to only create the intermediate C code, and not compile the 
918 results. Does an implicit B<-sav>, saving the C code rather than deleting it.
919
920 =item -run
921
922 Immediately run the perl code that has been generated. NOTE: IF YOU GIVE THE 
923 B<-run> FLAG TO B<perlcc>, THEN THE REST OF @ARGV WILL BE INTERPRETED AS 
924 ARGUMENTS TO THE PROGRAM THAT YOU ARE COMPILING.
925
926 =item -prog
927
928 Indicate that the programs at the command line are programs, and should be
929 compiled as such. B<perlcc> will automatically determine files to be 
930 programs if they have B<.p>, B<.pl>, B<.bat> extensions.
931
932 =item -mod
933
934 Indicate that the programs at the command line are modules, and should be
935 compiled as such. B<perlcc> will automatically determine files to be 
936 modules if they have the extension B<.pm>.
937
938 =back
939
940 =head1 ENVIRONMENT
941
942 Most of the work of B<perlcc> is done at the command line. However, you can 
943 change the heuristic which determines what is a module and what is a program.
944 As indicated above, B<perlcc> assumes that the extensions:
945
946 .p$, .pl$, and .bat$
947
948 indicate a perl program, and:
949
950 .pm$
951
952 indicate a library, for the purposes of creating executables. And furthermore,
953 by default, these extensions will be replaced (and dropped) in the process of 
954 creating an executable. 
955
956 To change the extensions which are programs, and which are modules, set the
957 environmental variables:
958
959 PERL_SCRIPT_EXT
960 PERL_MODULE_EXT
961
962 These two environmental variables take colon-separated, legal perl regular 
963 expressions, and are used by perlcc to decide which objects are which. 
964 For example:
965
966 setenv PERL_SCRIPT_EXT  '.prl$:.perl$'
967 prompt%   perlcc sample.perl
968
969 will compile the script 'sample.perl' into the executable 'sample', and
970
971 setenv PERL_MODULE_EXT  '.perlmod$:.perlmodule$'
972
973 prompt%   perlcc sample.perlmod
974
975 will  compile the module 'sample.perlmod' into the shared object 
976 'sample.so'
977
978 NOTE: the '.' in the regular expressions for PERL_SCRIPT_EXT and PERL_MODULE_EXT
979 is a literal '.', and not a wild-card. To get a true wild-card, you need to 
980 backslash the '.'; as in:
981
982 setenv PERL_SCRIPT_EXT '\.\.\.\.\.'
983
984 which would have the effect of compiling ANYTHING (except what is in 
985 PERL_MODULE_EXT) into an executable with 5 less characters in its name.
986
987 =head1 FILES
988
989 'perlcc' uses a temporary file when you use the B<-e> option to evaluate 
990 text and compile it. This temporary file is 'perlc$$.p'. The temporary C code is
991 perlc$$.p.c, and the temporary executable is perlc$$.
992
993 When you use '-run' and don't save your executable, the temporary executable is
994 perlc$$
995
996 =head1 BUGS
997
998 perlcc currently cannot compile shared objects on Win32. This should be fixed
999 by perl5.005.
1000
1001 =cut
1002
1003 !NO!SUBS!
1004
1005 close OUT or die "Can't close $file: $!";
1006 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1007 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1008 chdir $origdir;