|
Hi Guys, This has most likely been answered before but I have to ask as I have searched this mailing list and can't find the answer I am looking for. It is also most likely in the mod_perl 2,0 documentation and if there is a relevant part of it you can point me to regarding my issue that would be good! I am running mod_perl 2 on a debian server using apache2 I have a <VirtualHost> directive which incorporates a mod_perl PerlTransHandler. This VirtualHost block of the config also has some Alias and SetEnv directives defined. The PerlTransHandler module behaves correctly and works well but it seems that when I execute a PHP document under this VirtualHost I lose the $_SERVER (%ENV in perl) variables and Alias settings I have set in the Apache VirtualHost block of my config. Attached is my PerlTransHandler and my PerlFixupHandler as well as my Apache configuration. --
Kind regards, Geoff T
|
<VirtualHost *:80>
ServerName www.test.com
ServerAlias www.test.com
ServerAdmin [email protected]
<Perl>
use lib '/etc/SysAdmin/perl5/Handlers/';
</Perl>
DocumentRoot /vhosts/www/htdocs/
CustomLog /vhosts/www/logs/http-accesslog combined
ErrorLog /vhosts/www/logs/http-errorlog
PerlTransHandler +MyTransHandler
PerlFixupHandler +MyFixUpHandler
PerlSetEnv ConfigPath /etc/SysAdmin/perl5/
Alias /css/main.css /etc/SysAdmin/PrivateLabel/trunk/2/css/main.css
</VirtualHost>
package MyFixUpHandler;
use strict;
use warnings FATAL => qw(all);
use Apache2::Const -compile => qw(DIR_MAGIC_TYPE OK DECLINED);
use Apache2::RequestRec;
sub handler {
my $r = shift;
if ($r->handler eq 'perl-script' && -d $r->filename && $r->is_initial_req){
$r->handler(Apache2::Const::DIR_MAGIC_TYPE);
return Apache2::Const::OK;
}
return Apache2::Const::DECLINED;
}
1;
package MyTransHandler;
use Apache2::RequestRec ();
use Apache2::Const -compile => qw(OK REDIRECT DECLINED);
sub handler {
my $r = shift;
my $dbh;
my $ClientID = 0;
if ($r->hostname() =~ /^(\d*).test.com$/) {
$r->subprocess_env('DB' => 'test');
$dbh = connectdb('test');
$ClientID = $1;
}else{
$r->headers_out->set(Location => "http://www.test.com";);
$r->status(REDIRECT);
return Apache2::Const::REDIRECT;
}
# check if client exists
my $sth = $dbh->prepare(qq{
SELECT * FROM Clients WHERE id=(?)
});
$sth->execute($ClientID);
my $ClientData = $sth->fetchrow_hashref;
$sth->finish;
if (not defined $ClientData) {
$r->headers_out->set(Location => "http://www.test.com";);
$r->status(REDIRECT);
return Apache2::Const::REDIRECT;
}else{
foreach my $key ( keys(%{$ClientData}) ) {
$r->subprocess_env('CLIENT_'.$key => $ClientData->{$key});
}
foreach my $key ( keys(%db) ) {
$r->subprocess_env('CLIENT_DATABASE_'.$key => $db{$key});
}
}
return Apache2::Const::DECLINED;
}
###
1
