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

 


Geoff Toogood
Analyst / Programmer & System Administration

a: Level 5, 128 Bundall Rd, Bundall QLD 4217, Australia
t: +61 7 5574 0681   f: +61 7 5574 0932
e: ge...@allotz.com
w: www.allotz.com

Allotz is a proud member of the following associations...

Hospitality Sales and Marketing Association International - Asian American Hotel Owners Association - American Hotel & Lodging Association - The OpenTravel Alliance
Allotz.com limited - Seriously Smart Travel Technology
<VirtualHost *:80>

        ServerName www.test.com
        ServerAlias www.test.com
        ServerAdmin webmas...@test.com

        <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

Reply via email to