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