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