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 change
 874 the verbosity level B<verbose_level> much in the same way that the '-D' switch
 875 changes perl's debugging level, by giving either a number which is the sum of
 876 bits you want or a list of letters representing what you wish to see. Here are
 877 the verbosity levels so far :
 878
 879     Bit 1(g):      Code Generation Errors to STDERR
 880     Bit 2(a):      Compilation Errors to STDERR
 881     Bit 4(t):      Descriptive text to STDERR
 882     Bit 8(f):      Code Generation Errors to file (B<-log> flag needed)
 883     Bit 16(c):     Compilation Errors to file (B<-log> flag needed)
 884     Bit 32(d):     Descriptive text to file (B<-log> flag needed)
 885
 886 If the B<-log> tag is given, the default verbose level is 63 (ie: mirroring
 887 all of perlcc's output to both the screen and to a log file). If no B<-log>
 888 tag is given, then the default verbose level is 7 (ie: outputting all of
 889 perlcc's output to STDERR).
 890
 891 NOTE: Because of buffering concerns, you CANNOT shadow the output of '-run' to
 892 both a file, and to the screen! Suggestions are welcome on how to overcome this
 893 difficulty, but for now it simply does not work properly, and hence will only go
 894 to the screen.
 895
 896 =item -log <logname>
 897
 898 Opens, for append, a logfile to save some or all of the text for a given
 899 compile command. No rewrite version is available, so this needs to be done
 900 manually.
 901
 902 =item -argv <arguments>
 903
 904 In combination with '-run' or '-e', tells perlcc to run the resulting
 905 executable with the string B<arguments> as @ARGV.
 906
 907 =item -sav
 908
 909 Tells perl to save the intermediate C code. Usually, this C code is the name
 910 of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
 911 for example. If used with the '-e' operator, you need to tell perlcc where to
 912 save resulting executables.
 913
 914 =item -gen
 915
 916 Tells perlcc to only create the intermediate C code, and not compile the
 917 results. Does an implicit B<-sav>, saving the C code rather than deleting it.
 918
 919 =item -run
 920
 921 Immediately run the perl code that has been generated. NOTE: IF YOU GIVE THE
 922 B<-run> FLAG TO B<perlcc>, THEN THE REST OF @ARGV WILL BE INTERPRETED AS
 923 ARGUMENTS TO THE PROGRAM THAT YOU ARE COMPILING.
 924
 925 =item -prog
 926
 927 Indicate that the programs at the command line are programs, and should be
 928 compiled as such. B<perlcc> will automatically determine files to be
 929 programs if they have B<.p>, B<.pl>, B<.bat> extensions.
 930
 931 =item -mod
 932
 933 Indicate that the programs at the command line are modules, and should be
 934 compiled as such. B<perlcc> will automatically determine files to be
 935 modules if they have the extension B<.pm>.
 936
 937 =back
 938
 939 =head1 ENVIRONMENT
 940
 941 Most of the work of B<perlcc> is done at the command line. However, you can
 942 change the heuristic which determines what is a module and what is a program.
 943 As indicated above, B<perlcc> assumes that the extensions:
 944
 945 .p$, .pl$, and .bat$
 946
 947 indicate a perl program, and:
 948
 949 .pm$
 950
 951 indicate a library, for the purposes of creating executables. And furthermore,
 952 by default, these extensions will be replaced (and dropped) in the process of
 953 creating an executable.
 954
 955 To change the extensions which are programs, and which are modules, set the
 956 environmental variables:
 957
 958 PERL_SCRIPT_EXT
 959 PERL_MODULE_EXT
 960
 961 These two environmental variables take colon-separated, legal perl regular
 962 expressions, and are used by perlcc to decide which objects are which.
 963 For example:
 964
 965 setenv PERL_SCRIPT_EXT  '.prl$:.perl$'
 966 prompt%   perlcc sample.perl
 967
 968 will compile the script 'sample.perl' into the executable 'sample', and
 969
 970 setenv PERL_MODULE_EXT  '.perlmod$:.perlmodule$'
 971
 972 prompt%   perlcc sample.perlmod
 973
 974 will  compile the module 'sample.perlmod' into the shared object
 975 'sample.so'
 976
 977 NOTE: the '.' in the regular expressions for PERL_SCRIPT_EXT and PERL_MODULE_EXT
 978 is a literal '.', and not a wild-card. To get a true wild-card, you need to
 979 backslash the '.'; as in:
 980
 981 setenv PERL_SCRIPT_EXT '\.\.\.\.\.'
 982
 983 which would have the effect of compiling ANYTHING (except what is in
 984 PERL_MODULE_EXT) into an executable with 5 less characters in its name.
 985
 986 =head1 FILES
 987
 988 'perlcc' uses a temporary file when you use the B<-e> option to evaluate
 989 text and compile it. This temporary file is 'perlc$$.p'. The temporary C code is
 990 perlc$$.p.c, and the temporary executable is perlc$$.
 991
 992 When you use '-run' and don't save your executable, the temporary executable is
 993 perlc$$
 994
 995 =head1 BUGS
 996
 997 perlcc currently cannot compile shared objects on Win32. This should be fixed
 998 by perl5.005.
 999
1000 =cut
1001
1002 !NO!SUBS!
1003
1004 close OUT or die "Can't close $file: $!";
1005 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1006 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1007 chdir $origdir;