view release on metacpan or  search on metacpan

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

# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package Apache::TestConfig;

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

use constant WIN32   => $^O eq 'MSWin32';
use constant OSX     => $^O eq 'darwin';
use constant CYGWIN  => $^O eq 'cygwin';
use constant NETWARE => $^O eq 'NetWare';
use constant SOLARIS => $^O eq 'solaris';
use constant AIX     => $^O eq 'aix';
use constant WINFU   => WIN32 || NETWARE;
use constant COLOR   => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;

use constant DEFAULT_PORT => 8529;

use constant IS_MOD_PERL_2       =>
    eval { require mod_perl2 } || 0;

use constant IS_MOD_PERL_2_BUILD => IS_MOD_PERL_2 &&
    eval { require Apache2::Build && Apache2::Build::IS_MOD_PERL_BUILD() };

use constant IS_APACHE_TEST_BUILD =>
    grep { -e "$_/lib/Apache/TestConfig.pm" }
         qw(Apache-Test . .. ../Apache-Test);

use lib ();
use File::Copy ();
use File::Find qw(finddepth);
use File::Basename qw(dirname);
use File::Path ();
use File::Spec::Functions qw(catfile abs2rel splitdir canonpath
                             catdir file_name_is_absolute devnull);
use Cwd qw(fastcwd);
use Socket ();
use Symbol ();

use Apache::TestConfigPerl ();
use Apache::TestConfigParse ();
use Apache::TestTrace;
use Apache::TestServer ();
use Apache::TestRun ();

use vars qw(%Usage);

%Usage = (
   top_dir          => 'top-level directory (default is $PWD)',
   t_dir            => 'the t/ test directory (default is $top_dir/t)',
   t_conf           => 'the conf/ test directory (default is $t_dir/conf)',
   t_logs           => 'the logs/ test directory (default is $t_dir/logs)',
   t_state          => 'the state/ test directory (default is $t_dir/state)',
   t_pid_file       => 'location of the pid file (default is $t_logs/httpd.pid)',
   t_conf_file      => 'test httpd.conf file (default is $t_conf/httpd.conf)',
   src_dir          => 'source directory to look for mod_foos.so',
   serverroot       => 'ServerRoot (default is $t_dir)',
   documentroot     => 'DocumentRoot (default is $ServerRoot/htdocs',
   port             => 'Port [port_number|select] (default ' . DEFAULT_PORT . ')',
   servername       => 'ServerName (default is localhost)',
   user             => 'User to run test server as (default is $USER)',
   group            => 'Group to run test server as (default is $GROUP)',
   bindir           => 'Apache bin/ dir (default is apxs -q BINDIR)',
   sbindir          => 'Apache sbin/ dir (default is apxs -q SBINDIR)',
   httpd            => 'server to use for testing (default is $bindir/httpd)',
   target           => 'name of server binary (default is apxs -q TARGET)',
   apxs             => 'location of apxs (default is from Apache2::BuildConfig)',
   startup_timeout  => 'seconds to wait for the server to start (default is 60)',
   httpd_conf       => 'inherit config from this file (default is apxs derived)',
   httpd_conf_extra => 'inherit additional config from this file',
   minclients       => 'minimum number of concurrent clients (default is 1)',
   maxclients       => 'maximum number of concurrent clients (default is minclients+1)',
   threadsperchild  => 'number of threads per child when using threaded MPMs (default is 10)',
   limitrequestline => 'global LimitRequestLine setting (default is 128)',
   perlpod          => 'location of perl pod documents (for testing downloads)',
   proxyssl_url     => 'url for testing ProxyPass / https (default is localhost)',
   sslca            => 'location of SSL CA (default is $t_conf/ssl/ca)',
   sslcaorg         => 'SSL CA organization to use for tests (default is asf)',
   sslproto         => 'SSL/TLS protocol version(s) to test',
   libmodperl       => 'path to mod_perl\'s .so (full or relative to LIBEXECDIR)',
   defines          => 'values to add as -D defines (for example, "VAR1 VAR2")',
   (map { $_ . '_module_name', "$_ module name"} qw(cgi ssl thread access auth php)),
);

my %filepath_conf_opts = map { $_ => 1 }
    qw(top_dir t_dir t_conf t_logs t_state t_pid_file t_conf_file src_dir serverroot
       documentroot bindir sbindir httpd apxs httpd_conf httpd_conf_extra
       perlpod sslca libmodperl);

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

    $self->genfile_warning($file, $from_file, $fh) unless $nowarning;

    $self->clean_add_file($file);

    return $fh;
}

# gen + write file
sub writefile {
    my($self, $file, $content, $nowarning) = @_;

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

    print $fh $content if $content;

    close $fh;
}

sub perlscript_header {

    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;