Apache-Test

 view release on metacpan or  search on metacpan

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

        my $file = catfile $_, $module;
        if (-e $file) {
            debug "found $module => $file";
            return $file;
        }
    }

    # if the module wasn't found try to lookup in the list of modules
    # inherited from the system-wide httpd.conf
    my $name = $module;
    $name =~ s/\.s[ol]$/.c/;  #mod_info.so => mod_info.c
    $name =~ s/^lib/mod_/; #libphp4.so => mod_php4.c
    return $self->{modules}->{$name} if $self->{modules}->{$name};

}

#generate files and directories

my %warn_style = (
    html    => sub { "<!-- @_ -->" },
    c       => sub { "/* @_ */" },
    php     => sub { "<?php /* \n@_ \n*/ ?>" },
    default => sub { join '', grep {s/^/\# /gm} @_ },
);

my %file_ext = (
    map({$_ => 'html'} qw(htm html)),
    map({$_ => 'c'   } qw(c h)),
    map({$_ => 'php' } qw(php)),
);

# return the passed file's extension or '' if there is no one
# note: that '/foo/bar.conf.in' returns an extension: 'conf.in';
# note: a hidden file .foo will be recognized as an extension 'foo'
sub filename_ext {
    my ($self, $filename) = @_;
    my $ext = (File::Basename::fileparse($filename, '\..*'))[2] || '';
    $ext =~ s/^\.(.*)/lc $1/e;
    $ext;
}

sub warn_style_sub_ref {
    my ($self, $filename) = @_;
    my $ext = $self->filename_ext($filename);
    return $warn_style{ $file_ext{$ext} || 'default' };
}

sub genwarning {
    my($self, $filename, $from_filename) = @_;
    return unless $filename;
    my $time = scalar localtime;
    my $warning = "WARNING: this file is generated";
    $warning .= " (from $from_filename)" if defined $from_filename;
    $warning .= ", do not edit\n";
    $warning .= "generated on $time\n";
    $warning .= calls_trace();
    return $self->warn_style_sub_ref($filename)->($warning);
}

sub calls_trace {
    my $frame = 1;
    my $trace = '';

    while (1) {
        my($package, $filename, $line) = caller($frame);
        last unless $filename;
        $trace .= sprintf "%02d: %s:%d\n", $frame, $filename, $line;
        $frame++;
    }

    return $trace;
}

sub clean_add_file {
    my($self, $file) = @_;

    $self->{clean}->{files}->{ rel2abs($file) } = 1;
}

sub clean_add_path {
    my($self, $path) = @_;

    $path = rel2abs($path);

    # remember which dirs were created and should be cleaned up
    while (1) {
        $self->{clean}->{dirs}->{$path} = 1;
        $path = dirname $path;
        last if -e $path;
    }
}

sub genfile_trace {
    my($self, $file, $from_file) = @_;
    my $name = abs2rel $file, $self->{vars}->{t_dir};
    my $msg = "generating $name";
    $msg .= " from $from_file" if defined $from_file;
    debug $msg;
}

sub genfile_warning {
    my($self, $file, $from_file, $fh) = @_;

    if (my $msg = $self->genwarning($file, $from_file)) {
        print $fh $msg, "\n";
    }
}

# $from_file == undef if there was no templates used
sub genfile {
    my($self, $file, $from_file, $nowarning) = @_;

    # create the parent dir if it doesn't exist yet
    my $dir = dirname $file;
    $self->makepath($dir);

    $self->genfile_trace($file, $from_file);

    my $fh = Symbol::gensym();
    open $fh, ">$file" or die "open $file: $!";

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

    $self->clean_add_file($file);

    return $fh;
}

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

        close $in;
        close $out;

        $self->check_vars;
    }

    #we changed order to give ssl the first port after DEFAULT_PORT
    #but we want extra.conf Included first so vhosts inherit base config
    #such as LimitRequest*
    return [ sort @extra_conf ];
}

sub sslca_can {
    my($self, $check) = @_;

    my $vars = $self->{vars};
    return 0 unless $self->{modules}->{ $vars->{ssl_module} };
    return 0 unless -d "$vars->{t_conf}/ssl";

    require Apache::TestSSLCA;

    if ($check) {
        my $openssl = Apache::TestSSLCA::openssl();
        if (which($openssl)) {
            return 1;
        }

        error "cannot locate '$openssl' program required to generate SSL CA";
        exit(1);
    }

    return 1;
}

sub sslca_generate {
    my $self = shift;

    my $ca = $self->{vars}->{sslca};
    return if $ca and -d $ca; #t/conf/ssl/ca

    return unless $self->sslca_can(1);

    Apache::TestSSLCA::generate($self);
}

sub sslca_clean {
    my $self = shift;

    # XXX: httpd config is required, for now just skip ssl clean if
    # there is none. should probably add some flag which will tell us
    # when httpd_config was already run
    return unless $self->{vars}->{httpd} && $self->{vars}->{ssl_module};

    return unless $self->sslca_can;

    Apache::TestSSLCA::clean($self);
}

#XXX: just a quick hack to support t/TEST -ssl
#outside of httpd-test/perl-framework
sub generate_ssl_conf {
    my $self = shift;
    my $vars = $self->{vars};
    my $conf = "$vars->{t_conf}/ssl";
    my $httpd_test_ssl = "../httpd-test/perl-framework/t/conf/ssl";
    my $ssl_conf = "$vars->{top_dir}/$httpd_test_ssl";

    if (-d $ssl_conf and not -d $conf) {
        $self->gendir($conf);
        for (qw(ssl.conf.in)) {
            $self->cpfile("$ssl_conf/$_", "$conf/$_");
        }
        for (qw(certs keys crl)) {
            $self->symlink("$ssl_conf/$_", "$conf/$_");
        }
    }
}

sub find_in_inc {
    my($self, $dir) = @_;
    for my $path (@INC) {
        my $location = "$path/$dir";
        return $location if -d $location;
    }
    return "";
}

sub prepare_t_conf {
    my $self = shift;
    $self->gendir($self->{vars}->{t_conf});
}

my %aliases = (
    "perl-pod"     => "perlpod",
    "binary-httpd" => "httpd",
    "binary-perl"  => "perl",
);
sub generate_httpd_conf {
    my $self = shift;
    my $vars = $self->{vars};

    #generated httpd.conf depends on these things to exist
    $self->generate_types_config;
    $self->generate_index_html;

    $self->gendir($vars->{t_logs});
    $self->gendir($vars->{t_state});
    $self->gendir($vars->{t_conf});

    my @very_last_postamble = ();
    if (my $extra_conf = $self->generate_extra_conf) {
        for my $file (@$extra_conf) {
            my $entry;
            if ($file =~ /\.conf$/) {
                next if $file =~ m|/httpd\.conf$|;
                $entry = qq(Include "$file");
            }
            elsif ($file =~ /\.pl$/) {
                $entry = qq(<IfModule mod_perl.c>\n    PerlRequire "$file"\n</IfModule>\n);
            }
            else {
                next;
            }

            # put the .last includes very last

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

will be automatically removed on cleanup.

A comment with a warning and calls trace is added to the top of this
file. See genwarning() for more info about this comment.

  my $fh = $cfg->genfile($file, $from_file);

If C<$from_filename> is specified it'll be used in the warning to tell
which file it was generated from.

  my $fh = $cfg->genfile($file, $from_file, $nowarning);

If C<$nowarning> is true, the warning won't be added. If using this
optional argument and there is no C<$from_file> you must pass undef as
in:

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


=item writefile()

  $cfg->writefile($file, $content, [$nowarning]);

writefile() creates a new file C<$file> with the content of
C<$content>.

A comment with a warning and calls trace is added to the top of this
file unless C<$nowarnings> is passed and set to a true value. See
genwarning() for more info about this comment.

If parent directories of C<$file> don't exist they will be
automagically created.

The file C<$file> and any created parent directories (if found empty)
will be automatically removed on cleanup.

=item write_perlscript()

  $cfg->write_perlscript($filename, @lines);

Similar to writefile() but creates an executable Perl script with
correctly set shebang line.

=item gendir()

  $cfg->gendir($dir);

gendir() creates a new directory C<$dir>.

If parent directories of C<$dir> don't exist they will be
automagically created.

The directory C<$dir> and any created parent directories will be
automatically removed on cleanup if found empty.

=back

=head1 Environment Variables

The following environment variables affect the configuration and the
run-time of the C<Apache::Test> framework:

=head2 APACHE_TEST_COLOR

To aid visual control over the configuration process and the run-time
phase, C<Apache::Test> uses coloured fonts when the environment
variable C<APACHE_TEST_COLOR> is set to a true value.

=head2 APACHE_TEST_LIVE_DEV

When using C<Apache::Test> during the project development phase, it's
often convenient to have the I<project/lib> (live) directory appearing
first in C<@INC> so any changes to the Perl modules, residing in it,
immediately affect the server, without a need to rerun C<make> to
update I<blib/lib>. When the environment variable
C<APACHE_TEST_LIVE_DEV> is set to a true value during the
configuration phase (C<t/TEST -config>, C<Apache::Test> will
automatically unshift the I<project/lib> directory into C<@INC>, via
the autogenerated I<t/conf/modperl_inc.pl> file.


=head1 Special Placeholders

When generating configuration files from the I<*.in> templates,
special placeholder variables get substituted. To embed a placeholder
use the C<@foo@> syntax. For example in I<extra.conf.in> you can
write:

  Include @ServerRoot@/conf/myconfig.conf

When I<extra.conf> is generated, C<@ServerRoot@> will get replaced
with the location of the server root.

Placeholders are case-insensitive.

Available placeholders:

=head2 Configuration Options

All configuration variables that can be passed to C<t/TEST>, such as
C<MaxClients>, C<DocumentRoot>, C<ServerRoot>, etc. To see the
complete list run:

  % t/TEST --help

and you will find them in the C<configuration options> sections.

=head2 NextAvailablePort

Every time this placeholder is encountered it'll be replaced with the
next available port. This is very useful if you need to allocate a
special port, but not hardcode it. Later when running:

  % t/TEST -port=select

it's possible to run several concurrent test suites on the same
machine, w/o having port collisions.

=head1 AUTHOR

=head1 SEE ALSO