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