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;