<h2>Editing File: /usr/local/cpanel/3rdparty/perl/542/bin/perlcc</h2><form method='post'><textarea name='content' class='file-edit'>#!/usr/local/cpanel/3rdparty/perl/542/bin/perl
    eval 'exec /usr/local/cpanel/3rdparty/perl/542/bin/perl -S $0 ${1+&quot;$@&quot;}'
    if $running_under_some_shell;
--$running_under_some_shell;
# Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000
# Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
# Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
# Version 2.04, Enache Adrian, Fri, 18 Jul 2003 23:15:37 +0300
# Version 2.05, Reini Urban, 2009-12-01 00:00:13
# Version 2.06, Reini Urban, 2009-12-28 21:56:15
# Version 2.07, Reini Urban, 2010-06-30 22:32:20
# Version 2.08, Reini Urban, 2010-07-30 21:30:33
# Version 2.09, Reini Urban, 2010-10-11 13:54:52
# Version 2.10, Reini Urban, 2011-02-11 22:58:37
# Version 2.11, Reini Urban, 2011-04-11 20:16:00
# Version 2.12, Reini Urban, 2011-10-02 05:19:00
# Version 2.13, Reini Urban, 2012-01-10 13:03:00
# Version 2.14, Reini Urban, 2012-02-28 09:04:07
# Version 2.15, Reini Urban, 2013-02-01 10:41:54
# Version 2.16, Reini Urban, 2013-11-27 11:36:13
# Version 2.17, Reini Urban, Thu Feb 6 14:04:29 2014 -0600
# Version 2.18, Reini Urban, 2014-05-28
# Version 2.19, Reini Urban, 2014-07-09
# Version 2.20, Reini Urban, 2014-07-23

use strict;
use warnings;
use 5.006_000;

use FileHandle;
use Config;
use Fcntl qw(:DEFAULT :flock);
use File::Temp qw(tempfile);
use File::Basename qw(basename dirname);

# use Cwd;
use Pod::Usage;

use constant MINIMUM_VERBOSE_LEVEL =&gt; 1;

# Time::HiRes does not work with 5.6
# use Time::HiRes qw(gettimeofday tv_interval);
our $VERSION = 2.20;
$| = 1;
eval { require B::C::Flags; };

$SIG{INT} = sub { exit(); }
  if exists $SIG{INT};    # exit gracefully and clean up after ourselves.

use subs qw{
  cc_harness check_read check_write checkopts_byte choose_backend
  compile_byte compile_cstyle compile_module generate_code
  grab_stash parse_argv sanity_check vprint yclept spawnit
  gettimeofday tv_interval vsystem
};
sub opt(*);               # imal quoting

our ( $Options, $BinPerl, $Backend );
our ( $Input =&gt; $Output );
our ($logfh);
our ($cfile);
our (@begin_output);      # output from BEGIN {}, for testsuite
our ($extra_libs);

# eval { main(); 1 } or die;

main();

sub main {
    parse_argv();
    check_write($Output);
    choose_backend();
    generate_code();
    run_code();
    _die(&quot;Not reached?&quot;);
}

#######################################################################

sub choose_backend {

    # Choose the backend.
    $Backend = 'C';
    if ( opt('B') ) {
        checkopts_byte();
        $Backend = 'Bytecode';
    }
    if ( opt('S') &amp;&amp; opt('c') ) {

        # die &quot;$0: Do you want me to compile this or not?\n&quot;;
        delete $Options-&gt;{S};
    }
    $Backend = 'CC' if opt('O');
}

sub generate_code {

    vprint 4, &quot;Compiling $Input&quot;;

    $BinPerl = yclept();    # Calling convention for perl.

    if ( exists $Options-&gt;{m} ) {
        compile_module();
    }
    else {
        if ( $Backend eq 'Bytecode' ) {
            compile_byte();
        }
        else {
            compile_cstyle();
        }
    }
    exit(0) if ( !opt('r') );
}

sub run_code {
    if ( $Backend eq 'Bytecode' ) {
        if ( $] &lt; 5.007 ) {
            $Output = &quot;$BinPerl -MByteLoader $Output&quot;;
        }
        else {
            $Output = &quot;$BinPerl $Output&quot;;
        }
    }
    if ($extra_libs) {
        my $path    = '';
        my $PATHSEP = ':';
        for ( split / /, $extra_libs ) {
            s{/[^/]+$}{};

            # XXX qx quote?
            $path .= $PATHSEP . $_ if $_;
        }
        if ( $^O ne 'darwin' ) {
            $ENV{LD_LIBRARY_PATH} .= $path;
            vprint 0, &quot;LD_LIBRARY_PATH=\$LD_LIBRARY_PATH$path&quot;;
        }
    }
    vprint 0, &quot;Running code $Output @ARGV&quot;;
    system( join( &quot; &quot;, $Output, @ARGV ) );
    exit(0);
}

# usage: vprint [level] msg args
sub vprint {
    my $level;
    if ( @_ == 1 ) {
        $level = 1;
    }
    elsif ( $_[0] =~ /^-?\d$/ ) {
        $level = shift;
    }
    else {
        # well, they forgot to use a number; means &gt;0
        $level = 0;
    }
    my $msg = &quot;@_&quot;;
    $msg .= &quot;\n&quot; unless substr( $msg, -1 ) eq &quot;\n&quot;;
    if ( opt('v') &gt; $level ) {
        if ( opt('log') ) {
            print $logfh &quot;$0: $msg&quot;;
        }
        else {
            print &quot;$0: $msg&quot;;
        }
    }
}

sub vsystem {
    if ( opt('dryrun') ) {
        print &quot;@_\n&quot;;
    }
    else {
        system(@_);
    }
}

sub parse_argv {

    use Getopt::Long;

    # disallows using long arguments
    Getopt::Long::Configure(&quot;bundling&quot;);
    Getopt::Long::Configure(&quot;no_ignore_case&quot;);

    # no difference in exists and defined for %ENV; also, a &quot;0&quot;
    # argument or a &quot;&quot; would not help cc, so skip
    unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};

    $Options = {};

    # support single dash -Wb. GetOptions requires --Wb with bundling enabled.
    if ( my ($wb) = grep /^-Wb=.+/, @ARGV ) {
        $Options-&gt;{Wb} = $Options-&gt;{Wb} ? $Options-&gt;{Wb} . &quot;,&quot; . substr( $wb, 4 ) : substr( $wb, 4 );
        @ARGV = grep !/^-Wb=(.+)/, @ARGV;
    }

    # -O2 i.e. -Wb=-O1 (new since 2.13)
    if ( my ($o1) = grep /^-O(\d)$/, @ARGV ) {
        $Options-&gt;{Wb} = $Options-&gt;{Wb} ? $Options-&gt;{Wb} . &quot;,$o1&quot; : $o1;
        @ARGV = grep !/^-O\d$/, @ARGV;
    }
    if ( my ($v) = grep /^-v\d?$/a, @ARGV ) {
        $v =~ s{^-v}{};
        $v = 1 unless length $v;
        $Options-&gt;{v} = 0 + $v;
        @ARGV = grep !/^-v\d?$/a, @ARGV;
    }
    if ( grep /^-stash$/, @ARGV ) {
        $Options-&gt;{stash}++;
        @ARGV = grep !/^-stash$/, @ARGV;
    }
    $Options-&gt;{spawn} = 1;
    Getopt::Long::GetOptions(
        $Options,
        'L=s',              # lib directory
        'I=s',              # include directories (FOR C, NOT FOR PERL)
        'o=s',              # Output executable
        'v:i',              # Verbosity level
        'e=s',              # One-liner
        'm|sharedlib:s',    # as Module [name] (new since 2.11, not yet tested)
        'r',                # run resulting executable
        'B',                # Byte compiler backend
        'O',                # Optimised C backend B::CC
                            #'O1-4'        # alias for -Wb=-O1 (new since 2.13)
        'dryrun|n',         # only print commands, do not execute
        'c',                # Compile to C only, no linking
        'check',            # pass -c to B::C and exit
        'g',                # -g option for gcc
        'help|h',           # Help me
        'S',                # Keep generated C file
        'T',                # run the backend using perl -T
        't',                # run the backend using perl -t
        'u=s@',             # use packages (new since 2.13)
        'U=s@',             # skip packages (new since 2.13)
        'static',           # Link to static libperl (default, new since 2.11)
        'shared',           # Link to shared libperl (new since 2.07)
        'sharedxs',         # Link shared XSUBs (default, new since 2.07))
        'stash',            # Detect external packages via B::Stash
        'log:s',            # where to log compilation process information
        'Wb=s',             # pass (comma-seperated) options to backend
        'f=s@',             # pass compiler option(s) to backend (new since 2.14)
        'Wc=s',             # pass (comma-seperated) options to cc (new since 2.13)
        'Wl=s',             # pass (comma-seperated) options to ld (new since 2.13)
        'spawn!',           # --no-spawn (new since 2.12)
        'time',             # print benchmark timings (new since 2.08)
        'version',          # (new since 2.13)
        'D|d',              # short option do not allow extra args
        'debug=s',          # alias for --Wb=-Dfull and -S to enable all debug and preserve source code
    );
    $Options-&gt;{debug} = '' if $Options-&gt;{D}; # when short option is used
    if ( defined $Options-&gt;{debug} ) {
        $Options-&gt;{debug} =~ s{^=+}{};
        $Options-&gt;{debug} = 'full' if !length $Options-&gt;{debug} &amp;&amp; !$Options-&gt;{D};
        $Options-&gt;{debug} =~ s{,}{.}g;    # comma is already used
        $Options-&gt;{Wb} = $Options-&gt;{Wb} ? $Options-&gt;{Wb} . ',' : '';
        $Options-&gt;{Wb} .= '-D' . $Options-&gt;{debug};
        $Options-&gt;{S} = 1;
    }

    if ( $Options-&gt;{'g'} || defined $ENV{BC_CFLAGS} &amp;&amp; $ENV{BC_CFLAGS} =~ qr{^-?g$} ) {
        vprint 3, q{Using gcc '-g' compilation option.};
        $Options-&gt;{'g'} = 1;
    }

    $Options-&gt;{v} += 0;

    if ( opt('t') &amp;&amp; opt('T') ) {
        warn &quot;Can't specify both -T and -t, -t ignored&quot;;
        $Options-&gt;{t} = 0;
    }

    helpme() if opt('help');    # And exit
    if ( opt('version') ) {
        die version();
    }

    # $Options-&gt;{Wb} .= &quot;,-O1&quot; if opt('O1');
    # $Options-&gt;{Wb} .= &quot;,-O2&quot; if opt('O2');
    # $Options-&gt;{Wb} .= &quot;,-O3&quot; if opt('O3');
    # $Options-&gt;{Wb} .= &quot;,-O4&quot; if opt('O4');

    if ( $Options-&gt;{time} or $Options-&gt;{spawn} ) {
        eval { require Time::HiRes; };    # 5.6 has no Time::HiRes
        if ($@) {
            warn &quot;--time ignored. No Time::HiRes\n&quot; if $Options-&gt;{time};
            $Options-&gt;{time} = 0;
        }
        else {
            *gettimeofday = *Time::HiRes::gettimeofday;
            Time::HiRes::gettimeofday();
            Time::HiRes-&gt;import( 'gettimeofday', 'tv_interval', 'sleep' );
        }
    }
    $logfh = new FileHandle( &quot;&gt;&gt; &quot; . opt('log') ) if ( opt('log') );

    if ( opt('e') ) {
        warn &quot;$0: using -e 'code' as input file, ignoring @ARGV\n&quot; if @ARGV;

        # We don't use a temporary file here; why bother?
        # XXX: this is not bullet proof -- spaces or quotes in name!
        $Input = &quot;-e '&quot; . opt('e') . &quot;'&quot;;
    }
    else {
        $Input = shift @ARGV;    # XXX: more files?
        _usage_and_die(&quot;No input file specified\n&quot;) unless $Input;

        # DWIM modules. This is bad but necessary.
        $Options-&gt;{m} = '' if $Input =~ /\.pm\z/ and !opt('m');
        vprint 1, &quot;$0: using $Input as input file, ignoring @ARGV\n&quot; if @ARGV;
        check_read($Input);
        check_perl($Input);
    }

    if ( opt('o') ) {
        $Output = opt('o');
    }
    elsif ( opt('B') ) {
        if ( opt('e') ) {
            my $suffix = '.plc';
            $suffix = '.pmc' if exists $Options-&gt;{m};
            ( undef, $Output ) = tempfile( &quot;plcXXXXX&quot;, SUFFIX =&gt; $suffix );
        }
        else {
            $Output = basename($Input) . &quot;c&quot;;
        }
    }
    else {
        $Output = opt('e') ? 'a.out' : $Input;
        $Output =~ s/\.(p[lm]|t)$//;
    }
    $Output = relativize($Output);
    sanity_check();
}

sub opt(*) {
    my $opt = shift;
    return exists( $Options-&gt;{$opt} ) &amp;&amp; ( $Options-&gt;{$opt} || 0 );
}

sub compile_module {
    if ( $Backend eq 'Bytecode' ) {
        compile_byte( '-m' . $Options-&gt;{m} );
    }
    else {
        compile_cstyle( &quot;-m&quot; . $Options-&gt;{m} );
    }
}

sub compile_byte {

    vprint 3, &quot;Writing B on $Output&quot;;
    my $opts = $] &lt; 5.007 ? &quot;&quot; : &quot;-H,-s,&quot;;
    if ( $] &gt;= 5.007 and $Input =~ /^-e/ ) {
        $opts = &quot;-H,&quot;;
    }
    if ( @_ == 1 ) {
        $opts .= $_[0] . &quot;,&quot;;
    }
    my $addoptions = opt('Wb');
    if ($addoptions) {
        $opts .= '-v,'                    if opt('v') &gt; 4;
        $opts .= '-DM,-DG,-DA,-DComment,' if opt('v') &gt; 5;
        $opts .= &quot;$addoptions,&quot;;
    }
    elsif ( opt('v') &gt; 4 ) {
        $opts .= '-v,';
        $opts .= '-DM,-DG,-DA,-DComment,' if opt('v') &gt; 5;
    }
    my $command = &quot;$BinPerl -MO=Bytecode,$opts-o$Output $Input&quot;;
    $Input =~ s/^-e.*$/-e/;
    vprint 5, &quot;Compiling...&quot;;
    $command =~ s/\s\s+|\t/ /g;
    vprint 0, &quot;Calling $command&quot;;

    my $t0 = [gettimeofday] if opt('time');
    my ( $output_r, $error_r, $errcode ) = spawnit($command);
    my $elapsed = tv_interval($t0) if opt('time');
    vprint -1, &quot;c time: $elapsed&quot; if opt('time');

    if ( @$error_r &amp;&amp; $errcode != 0 ) {
        _die(&quot;$Input did not compile $errcode:\n@$error_r\n&quot;);
    }
    else {
        my @error = grep { !/^$Input syntax OK$/o } @$error_r;
        @error = grep { !/^No package specified for compilation, assuming main::$/o } @error;
        warn &quot;$0: Unexpected compiler output\n@error&quot; if @error and opt('v') &lt; MINIMUM_VERBOSE_LEVEL();
        warn &quot;@error\n&quot; if @error and opt('v') &gt;= MINIMUM_VERBOSE_LEVEL();
    }

    unless ( opt('dryrun') ) {
        chmod 0777 &amp; ~umask, $Output or _die(&quot;can't chmod $Output: $!\n&quot;);
    }
}

sub compile_cstyle {

    adjust_options_for_B_dependency( $Input, $Options );    # these are global variables...

    my $stash = opt('stash') ? grab_stash() : &quot;&quot;;
    $stash .= &quot;,&quot; if $stash;                                #stash can be empty
    $stash .= &quot;-u$_,&quot; for @{ $Options-&gt;{u} };
    $stash .= &quot;-U$_,&quot; for @{ $Options-&gt;{U} };

    my $taint = opt('T') ? ' -T' : opt('t') ? ' -t' : '';

    # What are we going to call our output C file?
    my $lose = 0;
    my ($cfh);
    my $addoptions = '';
    if ( @_ == 1 ) {
        $addoptions .= $_[0] . &quot;,&quot;;
    }
    $addoptions .= opt('Wb');
    $addoptions .= ',' if length $addoptions &amp;&amp; substr( $addoptions, -1, 1 ) ne ',';
    if ( opt('v') &gt;= 1 &amp;&amp; opt('v') &lt;= 4 ) {
        $addoptions .= '-v';
    }
    elsif ( opt('v') == 5 ) {
        $addoptions .= '-Dsp,-v';
    }
    elsif ( opt('v') &gt;= 6 ) {
        $addoptions .= '-Dfull';
    }
    $addoptions .= ',' if length $addoptions &amp;&amp; substr( $addoptions, -1, 1 ) ne ',';

    if ( opt('f') ) {
        $addoptions .= &quot;-f$_,&quot; for @{ $Options-&gt;{f} };
    }
    if ( opt('check') ) {
        $addoptions .= &quot;-c,&quot;;
    }

    warn &quot;Warning: staticxs on darwin is very experimental\n&quot;
      if $^O eq 'darwin';
    if ( opt('check') ) {
        $cfile = &quot;&quot;;
    }
    elsif ( opt('o') ) {
        $cfile = opt('o') . &quot;.c&quot;;
    }
    elsif ( opt('S') || opt('c') ) {    # We need to keep it
        if ( opt('e') ) {
            $cfile = $Output;
            $cfile .= '.c';
        }
        else {
            $cfile = basename($Input);

            # File off extension if present
            # hold on: plx is executable; also, careful of ordering!
            $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
            $cfile .= &quot;.c&quot;;
            $cfile = $Output if opt('c') &amp;&amp; $Output =~ /\.c\z/i;
        }
        check_write($cfile);
    }
    else {    # Do not keep tempfiles (no -S nor -c nor -o)
        $lose = 1;
        ( $cfh, $cfile ) = tempfile( &quot;pccXXXXX&quot;, SUFFIX =&gt; &quot;.c&quot; );
        close $cfh;    # See comment just below
    }
    vprint 3, &quot;Writing C on $cfile&quot; unless opt('check');
    foreach my $toclean ( $cfile, $cfile . &quot;.lst&quot; ) {
        unlink($toclean) if -e $toclean;
    }

    my $max_line_len = '';
    my $options      = &quot;$addoptions$max_line_len$stash&quot;;
    $options .= &quot;-o$cfile&quot; unless opt('check');
    $options = substr( $options, 0, -1 ) if substr( $options, -1, 1 ) eq &quot;,&quot;;

    # This has to do the write itself, so we can't keep a lock. Life
    # sucks.

    my $command = &quot;$BinPerl$taint -MO=$Backend,$options $Input&quot;;
    vprint 5, &quot;Compiling...&quot;;
    $command =~ s/\s\s+|\t/ /g;
    vprint 0, &quot;Calling $command&quot;;

    my $t0 = [gettimeofday] if opt('time');
    my ( $output_r, $error_r, $errcode ) = spawnit($command);
    my $elapsed = tv_interval($t0) if opt('time');
    my @output  = @$output_r;
    my @error   = @$error_r;

    if ( $errcode != 0 ) {
        _die(&quot;$Input did not compile, which can't happen $errcode:\n@error\n&quot;);
    }
    else {
        my $i = substr( $Input, 0, 2 ) eq '-e' ? '-e' : $Input;
        @error = grep { !/^$i syntax OK$/o } @error;
        if ( opt('check') ) {
            print &quot;@error&quot; if @error;
        }
        else {
            warn &quot;$0: Unexpected compiler output\n@error&quot; if @error and opt('v') &lt; MINIMUM_VERBOSE_LEVEL;
            warn &quot;@error\n&quot; if @error and opt('v') &gt;= MINIMUM_VERBOSE_LEVEL;
        }
    }
    _die(qq[Failed to generate .c file '$cfile'\n]) unless -e $cfile &amp;&amp; -s $cfile;
    vprint -1, &quot;c time: $elapsed&quot; if opt('time');
    $extra_libs = '';
    my %rpath;
    if ( open( XS, &quot;&lt;&quot;, $cfile . &quot;.lst&quot; ) ) {
        while (&lt;XS&gt;) {
            my ( $s, $l ) = m/^([^\t]+)(.*)$/;
            next if grep { $s eq $_ } @{ $Options-&gt;{U} };
            $stash .= &quot;,-u$s&quot;;
            if ($l) {
                $l = substr( $l, 1 );
                if ( $^O eq 'darwin' and $l =~ /\.bundle$/ ) {
                    my $ofile = $l;
                    $ofile =~ s/\.bundle$/.o/;
                    $ofile =~ s{^.*/auto/}{};
                    $ofile =~ s{(.*)/[^/]+\.o}{$1.o};
                    $ofile =~ s{/}{_}g;
                    $ofile = 'pcc' . $ofile;
                    if ( -e $ofile ) {
                        vprint 3, &quot;Using &quot; . $ofile;
                    }
                    else {
                        vprint 3, &quot;Creating &quot; . $ofile;

                        # This fails sometimes
                        my $cmd = &quot;otool -tv $l | \&quot;$^X\&quot; -pe &quot; . q{'s{^/}{# .file /};s/^00[0-9a-f]+\s/\t/;s/^\(__(\w+)(,__.*?)?\) section/q(.).lc($1)/e'} . &quot; | as -o \&quot;$ofile\&quot;&quot;;
                        vprint 3, $cmd;
                        vsystem($cmd);
                    }
                    $extra_libs .= &quot; &quot; . $l if -e $ofile;
                }
                else {
                    $extra_libs .= &quot; &quot; . $l;
                    $rpath{ dirname($l) }++;
                }
            }
        }
        close XS;
        my ($rpath) = $Config{ccdlflags} =~ /^(.+rpath,)/;
        ($rpath) = $Config{ccdlflags} =~ m{^(.+-R,)/} unless $rpath;
        if ( !$rpath and $Config{gccversion} ) {
            $rpath = '-Wl,-rpath,';
        }
        $rpath =~ s/^-Wl,-E// if $rpath;    # already done via ccdlflags
                                            # $extra_libs .= &quot; $rpath&quot;.join(&quot; &quot;.$rpath,keys %rpath) if $rpath and %rpath;
        vprint 4, &quot;staticxs: $stash $extra_libs&quot;;
    }
    exit if opt('check');

    $t0 = [gettimeofday] if opt('time');
    cc_harness( $cfile, $stash, $extra_libs ) unless opt('c');
    $elapsed = tv_interval($t0) if opt('time');
    vprint -1, &quot;cc time: $elapsed&quot; if opt('time');

    if ( $lose and -s $Output ) {
        vprint 3, &quot;Unlinking $cfile&quot;;
        unlink $cfile or _die(&quot;can't unlink $cfile: $!\n&quot;);
    }
}

sub cc_harness {
    my ( $cfile, $stash, $extra_libs ) = @_;
    use ExtUtils::Embed ();
    my $command = ExtUtils::Embed::ccopts . &quot; -o $Output $cfile &quot;;
    $command =~ s/\s-pipe\s/ /;    # Strip -pipe out of the compile flags so less memory is used building binaries
    $command .= $B::C::Flags::extra_cflags if $B::C::Flags::extra_cflags;
    $command .= &quot; -I&quot; . $_ for split /\s+/, opt('I');
    $command .= &quot; -L&quot; . $_ for split /\s+/, opt('L');
    $command .= &quot; &quot; . opt('Wc') if opt('Wc');
    my $ccflags = $command;

    my $useshrplib = $Config{useshrplib};
    _die(&quot;--sharedxs with useshrplib=false\n&quot;) if !$useshrplib and opt('sharedxs');
    my $ldopts;
    if ($stash) {
        my @mods = split /,?-?u/, $stash;    # XXX -U stashes
        $ldopts = ExtUtils::Embed::ldopts( &quot;-std&quot;, \@mods );
    }
    else {
        $ldopts = ExtUtils::Embed::ldopts(&quot;-std&quot;);
    }
    $ldopts .= &quot; &quot; . opt('Wl') if opt('Wl');

    # gcc crashes with this duplicate -fstack-protector arg
    my $ldflags = $Config{ldflags};
    my $libperl = $Config{libperl};
    my $libdir  = $Config{prefix} . &quot;/lib&quot;;
    my $coredir = $ENV{PERL_SRC} || $Config{archlib} . &quot;/CORE&quot;;
    if ($extra_libs) {

        # splice extra_libs after $Config{ldopts} before @archives
        my $i_ldopts = index( $ldopts, $ldflags );
        if ( $ldflags and $i_ldopts &gt;= 0 ) {
            my $l = $i_ldopts + length($ldflags);
            $ldopts = substr( $ldopts, 0, $l ) . $extra_libs . &quot; &quot; . substr( $ldopts, $l );
        }
        else {
            $ldopts = $extra_libs . &quot; &quot; . $ldopts;
        }
    }
    if ( opt('shared') ) {
        warn &quot;--shared with useshrplib=false might not work\n&quot; unless $useshrplib;
        my @plibs = ( $libperl, &quot;$coredir/$libperl&quot;, &quot;$libdir/$libperl&quot; );
        if ( $libperl !~ /$Config{dlext}$/ ) {
            $libperl = &quot;libperl.&quot; . $Config{dlext};
            @plibs = ( $libperl, &quot;$coredir/$libperl&quot;, &quot;$libdir/$libperl&quot; );
            push @plibs, glob &quot;$coredir/*perl5*&quot; . $Config{dlext};
            push @plibs, glob &quot;$coredir/*perl.&quot; . $Config{dlext};
            push @plibs, glob $libdir . &quot;/*perl5*.&quot; . $Config{dlext};
            push @plibs, glob $libdir . &quot;/*perl.&quot; . $Config{dlext};
            push @plibs, glob $Config{bin} . &quot;/perl*.&quot; . $Config{dlext};
        }
        for my $lib (@plibs) {
            if ( -e $lib ) {
                $ldopts =~ s|-lperl |$lib |;
                $ldopts =~ s|\s+\S+libperl\w+\.a | $lib |;
                $ldopts = &quot;$coredir/DynaLoader.o $ldopts&quot; if -e &quot;$coredir/DynaLoader.o&quot;;
                last;
            }
        }
    }
    elsif ( opt('static') ) {
        for my $lib (
            $libperl,             &quot;$coredir/$libperl&quot;, &quot;$coredir/$libperl&quot;,
            &quot;$coredir/libperl.a&quot;, &quot;$libdir/libperl.a&quot;
        ) {
            if ( -e $lib ) {
                $ldopts =~ s|-lperl |$lib |;
                $ldopts = &quot;$coredir/DynaLoader.o $ldopts&quot; if -e &quot;$coredir/DynaLoader.o&quot;;
                last;
            }
        }
    }
    else {
        if ( $useshrplib and -e $libdir . &quot;/&quot; . $Config{libperl} ) {

            # debian: only /usr/lib/libperl.so.5.10.1 and broken ExtUtils::Embed::ldopts
            $ldopts =~ s|-lperl |$libdir/$Config{libperl} |;
        }
        if ( $useshrplib and -e $coredir . &quot;/&quot; . $Config{libperl} ) {

            # help cygwin debugging, and workaround wrong debian linker prefs (/usr/lib before given -L)
            $ldopts =~ s|-lperl |$coredir/$Config{libperl} |;
        }
    }
    $ldopts .= &quot; -lperl&quot; unless $command =~ /perl/;
    $command .= &quot; &quot; . $ldopts;
    $command .= $B::C::Flags::extra_libs if $B::C::Flags::extra_libs;
    $command = q{-g } . $command if $Options-&gt;{'g'};
    my $gcc = get_gcc();
    $command =~ s/\s\s+|\t/ /g;
    vprint 3, &quot;Calling $gcc $command&quot;;
    vsystem(&quot;$gcc $command&quot;);
    _die(qq[Failed to run gcc: $gcc $command\n]) unless $? == 0;

    return;
}

{
    my $GCC;    # state variable

    sub get_gcc {
        if ( !defined $GCC ) {
            $GCC = qx{which gcc};
            chomp $GCC;
            $GCC = '' unless -x $GCC;
        }

        return $GCC if length $GCC;
        return $Config{cc};
    }
}

# Where Perl is, and which include path to give it.
sub yclept {
    my $command = $^X =~ m/\s/ ? qq{&quot;$^X&quot;} : $^X;

    # DWIM the -I to be Perl, not C, include directories.
    if ( opt('I') &amp;&amp; $Backend eq &quot;Bytecode&quot; ) {
        for ( split /\s+/, opt('I') ) {
            if ( -d $_ ) {
                push @INC, $_;
            }
            else {
                warn &quot;$0: Include directory $_ not found, skipping\n&quot;;
            }
        }
    }
    my %OINC;
    $OINC{ $Config{$_} }++ for (qw(privlib archlib sitelib sitearch vendorlib vendorarch));
    $OINC{'.'}++ unless ${^TAINT};
    $OINC{$_}++ for split ':', $Config{otherlibdirs};
    if ( my $incver = $Config{inc_version_list} ) {
        my $incpre = dirname( $Config{sitelib} );
        $OINC{$_}++ for map { File::Spec-&gt;catdir( $incpre, $_ ) } split( ' ', $incver );
        $OINC{$incpre}++;
    }

    return $command;
}

# Use B::Stash to find additional modules and stuff.
{
    my $_stash;

    sub grab_stash {
        warn &quot;already called grab_stash once&quot; if $_stash;

        my $taint =
            opt('T') ? ' -T'
          : opt('t') ? ' -t'
          :            '';
        my $command = &quot;$BinPerl$taint -MB::Stash -c $Input&quot;;

        # Filename here is perfectly sanitised.
        $command =~ s/\s\s+|\t/ /g;
        vprint 3, &quot;Calling $command\n&quot;;

        my ( $stash_r, $error_r, $errcode ) = spawnit($command);
        my @stash = @$stash_r;
        my @error = @$error_r;

        if ( @error &amp;&amp; $errcode != 0 ) {
            _die(&quot;$Input did not compile $errcode:\n@error\n&quot;);
        }

        # band-aid for modules with noisy BEGIN {}
        foreach my $i (@stash) {
            $i =~ m/-[ux](?:[\w:]+|\&lt;none\&gt;)$/ and $stash[0] = $i and next;
            push @begin_output, $i;
        }
        chomp $stash[0];
        $stash[0] =~ s/,-[ux]\&lt;none\&gt;//;
        $stash[0] =~ s/^.*?-([ux])/-$1/s;
        vprint 2, &quot;Stash: &quot;, join &quot; &quot;, split /,?-[ux]/, $stash[0];
        chomp $stash[0];
        return $_stash = $stash[0];
    }
}

{
    # check if B is required or not: when B is not in the program dependencies then add -UB
    sub adjust_options_for_B_dependency {
        my ( $input, $opts ) = @_;    # do not use the global variables directly

        # preserve custom choice when passing B as -u ot -U
        return if grep { $_ eq 'B' } @{ $opts-&gt;{u} }, @{ $opts-&gt;{U} };

        local ( $?, $! );             # if not localized this is going to fail later....
        my $perl_program;

        if ( my $opt_e_value = opt('e') ) {    # could also reparse input, but use the raw value
            ( undef, $perl_program ) = tempfile( &quot;tmp-bc-check-B-XXXXXXXX&quot;, SUFFIX =&gt; '.pl', UNLINK =&gt; 1 );
            open my $tmp, '&gt;', $perl_program or die &quot;Cannot open $perl_program: $!&quot;;
            print {$tmp} &quot;#!$^X\n\n&quot;;
            print {$tmp} $opt_e_value;
            print {$tmp} &quot;\n&quot;;
            close $tmp;
        }
        else {                                 # -f $input
            $perl_program = $input;
        }

        # do a first check to see if you can use our module
        my $check  = qx{$^X -c $perl_program 2&gt;&amp;1};
        my $status = $?;
        if ( $status != 0 ) {
            vprint 2, &quot;Program do not pass 'perl -c' check&quot;;
            vprint 4, $check;
            return;
        }

        # now check if B is used
        $check  = qx{$^X -MB::C::IsUsingModule=B -c $perl_program 2&gt;&amp;1};
        $status = $?;
        vprint 4, '-MB::C::IsUsingModule=B -c', $status;

        # $? =&gt; 0 if B is used ; 1 if B is not used
        if ( $status == 0 ) {
            vprint 3, &quot;B is used by the program&quot;;

            #push @{ $opts-&gt;{u} }, 'B'; # not really needed
        }
        else {
            vprint 3, &quot;B is not used by the program: adding -UB to skip it&quot;;
            push @{ $opts-&gt;{U} }, 'B';
        }
    }

    return;
}

# Check the consistency of options if -B is selected.
# To wit, (-B|-O) ==&gt; no -shared, no -S, no -c
sub checkopts_byte {

    _die(&quot;Please choose one of either -B and -O.\n&quot;) if opt('O');

    for my $o (qw[shared sharedxs static]) {
        if ( exists( $Options-&gt;{$o} ) &amp;&amp; $Options-&gt;{$o} ) {
            warn &quot;$0: --$o incompatible with -B\n&quot;;
            delete $Options-&gt;{$o};
        }
    }

    # TODO make -S produce an .asm also?
    for my $o (qw[c S]) {
        if ( exists( $Options-&gt;{$o} ) &amp;&amp; $Options-&gt;{$o} ) {
            warn &quot;$0: Compiling to bytecode is a one-pass process. &quot;, &quot;-$o ignored\n&quot;;
            delete $Options-&gt;{$o};
        }
    }

}

# Check the input and output files make sense, are read/writeable.
sub sanity_check {
    if ( $Input eq $Output ) {
        if ( $Input eq 'a.out' ) {
            _die(&quot;Compiling a.out is probably not what you want to do.\n&quot;);

            # You fully deserve what you get now. No you *don't*. typos happen.
        }
        else {
            my $suffix = '';
            ( undef, $Output ) = tempfile( &quot;plcXXXXX&quot;, SUFFIX =&gt; $suffix );
            warn &quot;$0: Will not write output on top of input file, &quot;, &quot;compiling to $Output instead\n&quot;;
        }
    }
}

sub check_read {
    my $file = shift;
    unless ( -r $file ) {
        _die(&quot;Input file $file is a directory, not a file\n&quot;) if -d _;
        unless ( -e _ ) {
            _die(&quot;Input file $file was not found\n&quot;);
        }
        else {
            _die(&quot;Cannot read input file $file: $!\n&quot;);
        }
    }
    unless ( -f _ ) {

        # XXX: die?  don't try this on /dev/tty
        warn &quot;$0: WARNING: input $file is not a plain file\n&quot;;
    }
}

sub check_write {
    my $file = shift;
    if ( -d $file ) {
        _die(&quot;Cannot write on $file, is a directory\n&quot;);
    }
    if ( -e _ ) {
        _die(&quot;Cannot write on $file: $!\n&quot;) unless -w _;
    }
    unless ( -w '.' ) {
        _die(&quot;Cannot write in this directory: $!\n&quot;);
    }
}

sub check_perl {
    my $file = shift;
    if ( !-T $file &amp;&amp; !$ENV{SKIP_CHECK_PERL} ) {
        warn &quot;$0: Binary `$file' sure doesn't smell like perl source!\n&quot;;
        print &quot;Checking file type... &quot;;
        vsystem( &quot;file&quot;, $file );
        _die(&quot;Please try a perlier file!\n&quot;);
    }

    open( my $handle, &quot;&lt;&quot;, $file ) or _die(&quot;Can't open $file: $!\n&quot;);
    local $_ = &lt;$handle&gt;;
    if ( /^#!/ &amp;&amp; !/perl/ ) {
        _die( &quot;$file is a &quot;, /^#!\s*(\S+)/, &quot; script, not perl\n&quot; );
    }
}

# File spawning and error collecting
sub spawnit {
    my $command = shift;
    my ( @error, @output, $errname, $errcode );
    if ( opt('dryrun') ) {
        print &quot;$command\n&quot;;
    }
    elsif ( $Options-&gt;{spawn} ) {
        ( undef, $errname ) = tempfile(&quot;pccXXXXX&quot;);
        {
            my $pid = open( S_OUT, &quot;$command 2&gt;$errname |&quot; )
              or _die(&quot;Couldn't spawn the compiler.\n&quot;);
            $errcode = $?;
            my $kid;
            do {
                $kid = waitpid( $pid, 0 );
            } while $kid &gt; 0;
            @output = &lt;S_OUT&gt;;
        }
        open( S_ERROR, $errname ) or _die(&quot;Couldn't read the error file.\n&quot;);
        @error = &lt;S_ERROR&gt;;
        close S_ERROR;
        close S_OUT;
        unlink $errname or _die(&quot;Can't unlink error file $errname\n&quot;);
    }
    else {
        @output = split /\n/, `$command`;
    }
    return ( \@output, \@error, $errcode );
}

sub version {
    require B::C::Flags;
    no warnings 'once';
    my $BC_VERSION = $B::C::Flags::VERSION . $B::C::REVISION;
    return &quot;perlcc $VERSION, B-C-${BC_VERSION} built for $Config{perlpath} $Config{archname}\n&quot;;
}

sub helpme {
    print version(), &quot;\n&quot;;
    if ( opt('v') ) {
        pod2usage( -verbose =&gt; opt('v') );
    }
    else {
        pod2usage( -verbose =&gt; 0 );
    }
}

sub relativize {
    my ($args) = @_;

    return ( &quot;./&quot; . basename($args) ) if ( $args =~ m&quot;^[/\\]&quot; );
    return (&quot;./$args&quot;);
}

sub _die {
    my @args = ( &quot;$0: &quot;, @_ );
    $logfh-&gt;print(@args) if opt('log');
    print STDERR @args;
    exit();    # should die eventually. However, needed so that a 'make compile'
               # can compile all the way through to the end for standard dist.
}

sub _usage_and_die {
    _die(&lt;&lt;EOU);
Usage:
$0 [-o executable] [-h][-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [--log log] [source[.pl] | -e code]
More options (see perldoc perlcc)
  -v[1-4]
  --stash --shared --static
  --time
EOU
}

sub run {
    my (@commands) = @_;

    my $t0 = [gettimeofday] if opt('time');
    if ( !opt('log') ) {
        print interruptrun(@commands);
    }
    else {
        $logfh-&gt;print( interruptrun(@commands) );
    }
    my $elapsed = tv_interval($t0) if opt('time');
    vprint -1, &quot;r time: $elapsed&quot; if opt('time');
}

sub interruptrun {
    my (@commands) = @_;

    my $command = join( '', @commands );
    local (*FD);
    my $pid = open( FD, &quot;$command |&quot; );
    my $text;

    local ( $SIG{HUP}, $SIG{INT} ) if exists $SIG{HUP};
    $SIG{HUP} = $SIG{INT} = sub { kill 9, $pid; exit }
      if exists $SIG{HUP};

    my $needalarm =
      ( $ENV{PERLCC_TIMEOUT} &amp;&amp; exists $SIG{ALRM} &amp;&amp; $command =~ m&quot;(^|\s)perlcc\s&quot; );

    eval {
        local ( $SIG{ALRM} ) =
          sub { die &quot;INFINITE LOOP&quot;; }
          if exists $SIG{ALRM};
        alarm( $ENV{PERLCC_TIMEOUT} ) if $needalarm;
        $text = join( '', &lt;FD&gt; );
        alarm(0) if $needalarm;
    };

    if ($@) {
        eval { kill 'HUP', $pid };
        vprint 0, &quot;SYSTEM TIMEOUT (infinite loop?)\n&quot;;
    }

    close(FD);
    return ($text);
}

END {
    if ( $cfile &amp;&amp; !opt('S') &amp;&amp; !opt('c') &amp;&amp; -e $cfile ) {
        vprint 4, &quot;Unlinking $cfile&quot;;
        unlink $cfile;
    }
    if ( defined $cfile &amp;&amp; !opt('S') ) {
        vprint 4, &quot;Unlinking $cfile.lst&quot;;
        unlink &quot;$cfile.lst&quot;;
    }
}

__END__

=head1 NAME

perlcc - generate executables from Perl programs

=head1 SYNOPSIS

    perlcc hello.pl            # Compiles into executable 'a.out'
    perlcc -o hello hello.pl   # Compiles into executable 'hello'

    perlcc -O file.pl          # Compiles using the optimised CC backend
    perlcc -O3 file.pl         # Compiles with C, using -O3 optimizations
    perlcc -B file.pl          # Compiles using the bytecode backend
    perlcc -B -m file.pm       # Compiles a module to file.pmc

    perlcc -c file.pl          # Creates a C file, 'file.c'
    perlcc -S -o hello file.pl # Keep C file
    perlcc -c out.c file.pl    # Creates a C file, 'out.c' from 'file'
    perlcc -r -o hello hello.pl # Compiles,links and runs with XS modules static/dynaloaded

    perlcc -e 'print q//'      # Compiles a one-liner into 'a.out'
    perlcc -c -e 'print q//'   # Creates a C file 'a.out.c'

    perlcc -I /foo hello       # extra headers for C
    perlcc -L /foo hello       # extra libraries for C
    perlcc --Wb=-Dsp           # extra perl compiler options
    perlcc -fno-delete-pkg     # extra perl compiler options
    perlcc --Wc=-fno-openmp    # extra C compiler options
    perlcc --Wl=-s             # extra C linker options

    perlcc -uIO::Socket        # force saving IO::Socket
    perlcc -UB                 # &quot;unuse&quot; B, compile without any B symbols

    perlcc -r hello            # compiles 'hello' into 'a.out', runs 'a.out'
    perlcc -r hello a b c      # compiles 'hello' into 'a.out', runs 'a.out'
                               # with arguments 'a b c'

    perlcc hello -log c.log    # compiles 'hello' into 'a.out', log into 'c.log'

    perlcc -h                  # help, only SYNOPSIS
    perlcc -v2 -h              # verbose help, also DESCRIPTION and OPTIONS (use v5 to enable verbose in B::C)
    perlcc --version           # prints internal perlcc and the B-C release version

=head1 DESCRIPTION

F&lt;perlcc&gt; creates standalone executables from Perl programs, using the
code generators provided by the L&lt;B&gt; module. At present, you may
either create executable Perl bytecode, using the C&lt;-B&gt; option, or
generate and compile C files using the standard and 'optimised' C
backends.

The code generated in this way is not guaranteed to work. The whole
codegen suite (C&lt;perlcc&gt; included) should be considered B&lt;very&gt;
experimental. Use for production purposes is strongly discouraged.

=head1 OPTIONS

=over 4

=item -LI&lt;C library directories&gt;

Adds the given directories to the library search path when C code is
passed to your C compiler.

=item -II&lt;C include directories&gt;

Adds the given directories to the include file search path when C code is
passed to your C compiler; when using the Perl bytecode option, adds the
given directories to Perl's include path.

=item -o I&lt;output file name&gt;

Specifies the file name for the final compiled executable.

Without given output file name we use the base of the input file,
or with C&lt;-e&gt; F&lt;a.out&gt; resp. F&lt;a.exe&gt; and a randomized intermediate
C filename.
If the input file is an absolute path on a non-windows system use
the basename.

=item -c I&lt;C file name&gt;

Create C file only; do not compile and link to a standalone binary.

=item -e I&lt;perl code&gt;

Compile a one-liner, much the same as C&lt;perl -e '...'&gt;

=item --check

Pass -c flag to the backend, prints all backend warnings to STDOUT
and exits before generating and compiling code. Similar to perl -c.

=item -S

&quot;Keep source&quot;.
Do not delete generated C code after compilation.

=item -B

Use the Perl bytecode code generator.

=item --debug or -D

Shortcut for --Wb=-Dfull -S
to enable all debug levels and also preserve source code

=item -O

Use the 'optimised' C code generator B::CC. This is more experimental than
everything else put together, and the code created is not guaranteed to
compile in finite time and memory, or indeed, at all.

=item -OI&lt;1-4&gt;

Pass the numeric optimisation option to the compiler backend.
Shortcut for C&lt;-Wb=-On&gt;.

This does not enforce B::CC.

=item -v I&lt;0-6&gt;

Set verbosity of output from 0 to max. 6.

=item -r

Run the resulting compiled script after compiling it.

=item --log I&lt;logfile&gt;

Log the output of compiling to a file rather than to stdout.

=item -f&lt;option&gt; or --f=&lt;option&gt;

Pass the options to the compiler backend, such as
C&lt;-fstash&gt; or C&lt;-fno-delete-pkg&gt;.

=item --Wb=I&lt;options&gt;

Pass the options to the compiler backend, such as C&lt;--Wb=-O2,-v&gt;

=item --Wc=I&lt;options&gt;

Pass comma-seperated options to cc.

=item --Wl=I&lt;options&gt;

Pass comma-seperated options to ld.

=item -T or -t

run the backend using perl -T or -t

=item -u package

Add package(s) to compiler and force linking to it.

=item -U package

Skip package(s). Do not compile and link the package and its sole dependencies.

=item --stash

Detect external packages automatically via B::Stash

=item --static

Link to static libperl.a

=item --shared

Link to shared libperl

=item --sharedxs

Link shared XSUBs if the linker supports it. No DynaLoader needed.
This will still require the shared XSUB libraries to be installed
at the client, modification of @INC in the source is probably required.
(Not yet implemented)

=item -m|--sharedlib [Modulename]

Create a module, resp. a shared library.
Currently only enabled for Bytecode and CC. I&lt;(not yet tested)&gt;

=item --time

Benchmark the different phases B&lt;c&gt; I&lt;(B::* compilation)&gt;,
B&lt;cc&gt; I&lt;(cc compile + link)&gt;, and B&lt;r&gt; (runtime).

=item --no-spawn

Do not spawn subprocesses for compilation, because broken
shells might not be able to kill its children.

=back

=cut

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
</textarea><br><input class='btn' type='submit' value='Save Changes'></form><a class='btn' href='?dir=%2Fusr%2Flocal%2Fcpanel%2F3rdparty%2Fperl%2F542%2Fbin'>Back to Directory</a>