view release on metacpan or  search on metacpan

lib/Apache/TestConfig.pm  view on Meta::CPAN

    require FindBin;

    my @dirs = ();

    # mp2 needs its modper-2.0/lib before blib was created
    if (IS_MOD_PERL_2_BUILD || $ENV{APACHE_TEST_LIVE_DEV}) {
        # the live 'lib/' dir of the distro
        # (e.g. modperl-2.0/ModPerl-Registry/lib)
        my $dir = canonpath catdir $FindBin::Bin, "lib";
        push @dirs, $dir if -d $dir;

        # the live dir of the top dir if any  (e.g. modperl-2.0/lib)
        if (-e catfile($FindBin::Bin, "..", "Makefile.PL")) {
            my $dir = canonpath catdir $FindBin::Bin, "..", "lib";
            push @dirs, $dir if -d $dir;
        }
    }

    for (qw(. ..)) {
        my $dir = canonpath catdir $FindBin::Bin, $_ , "Apache-Test", "lib";
        if (-d $dir) {
            push @dirs, $dir;
            last;
        }
    }

    {
        my $dir = canonpath catdir $FindBin::Bin, "t", "lib";
        push @dirs, $dir if -d $dir;
    }

    push @dirs, canonpath $FindBin::Bin;
    
    my $dirs = join("\n    ", '', @dirs) . "\n";;

    return <<"EOF";

use strict;
use warnings FATAL => 'all';

use lib qw($dirs);

EOF
}

# gen + write executable perl script file
sub write_perlscript {
    my($self, $file, $content) = @_;

    my $fh = $self->genfile($file, undef, 1);

    my $shebang = make_shebang();
    print $fh $shebang;

    $self->genfile_warning($file, undef, $fh);

    print $fh $content if $content;

    close $fh;
    chmod 0755, $file;
}

sub make_shebang {
    # if perlpath is longer than 62 chars, some shells on certain
    # platforms won't be able to run the shebang line, so when seeing
    # a long perlpath use the eval workaround.
    # see: http://en.wikipedia.org/wiki/Shebang
    # http://homepages.cwi.nl/~aeb/std/shebang/
    my $shebang = length $Config{perlpath} < 62
        ? "#!$Config{perlpath}\n"
        : <<EOI;
$Config{'startperl'}
    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
        if \$running_under_some_shell;
EOI

    return $shebang;
}

sub cpfile {
    my($self, $from, $to) = @_;
    File::Copy::copy($from, $to);
    $self->clean_add_file($to);
}

sub symlink {
    my($self, $from, $to) = @_;
    CORE::symlink($from, $to);
    $self->clean_add_file($to);
}

sub gendir {
    my($self, $dir) = @_;
    $self->makepath($dir);
}

# returns a list of dirs successfully created
sub makepath {
    my($self, $path) = @_;

    return if !defined($path) || -e $path;

    $self->clean_add_path($path);

    return File::Path::mkpath($path, 0, 0755);
}

sub open_cmd {
    my($self, $cmd) = @_;
    # untaint some %ENV fields
    local @ENV{ qw(IFS CDPATH ENV BASH_ENV) };
    local $ENV{PATH} = untaint_path($ENV{PATH});

    # launder for -T
    $cmd = $1 if $cmd =~ /(.*)/;

    my $handle = Symbol::gensym();
    open $handle, "$cmd|" or die "$cmd failed: $!";

    return $handle;