[Thu Nov 12 23:30:56 2009] [notice] child pid 21117 exit signal Alarm clock (14)
[Fri Nov 13 00:14:54 2009] [notice] child pid 21309 exit signal Alarm clock (14)
[Fri Nov 13 00:49:55 2009] [error] [client 66.249.71.244] cache old slots mistmatch at /usr/local/lib/perl/5.10.0/Cache/FastMmap.pm line 656.\n
[Fri Nov 13 01:46:04 2009] [error] [client 68.40.244.40] cache old slots mistmatch at /usr/local/lib/perl/5.10.0/Cache/FastMmap.pm line 656.\n
####
PerlModule My::VirtualHost
PerlTransHandler My::VirtualHost::TransHandler
##
##
package My::VirtualHost::TransHandler;
use strict;
use warnings;
use Apache2::Const -compile => qw(OK DECLINED);
use Apache2::RequestRec ();
use My::Config;
use DBI;
use Cache::FastMmap;
# This happens globally in the parent process
our $cache = Cache::FastMmap->new(
read_cb => \&get_virthost,
expire_time => '1m',
init_file => 1,
cache_not_found => 1,
);
our($dbh,$sth);
sub get_sth {
if (!$dbh) {
$dbh = DBI->connect(My::Config::DB_DSN, My::Config::DB_USER, My::Config::DB_PASS)
or die "Couldn't connect to database\n";
$sth = $dbh->prepare('SELECT virthost_id FROM virtual_hosts WHERE url = lower(?)')
or die "Couldn't prepare statement\n";
}
return $sth;
}
sub get_virthost {
my($ctx,$hn)=@_;
my $ret;
eval {
my $url = 'http://'.$hn;
my $sth = get_sth();
$sth->execute($url);
my $row = $sth->fetchrow_arrayref();
if ($row && defined($row->[0])) {
$ret = $row->[0];
} else {
$ret = undef;
}
$sth->finish();
return $ret;
};
if ($@) {
# TODO: Some kind of error handling
warn "Error getting virtual host: $@";
$ret = undef;
}
$ret;
}
sub handler {
my $r = shift;
my $hn = $r->hostname();
if (!$hn) {
# TODO: Return some kind of error
return Apache2::Const::DECLINED;
}
my $id = $cache->get($hn);
if (defined($id)) {
my $newfn = My::Config::BASE_PATH . "/virthosts/$id".$r->uri();
$r->filename($newfn);
return Apache2::Const::OK;
} else {
return Apache2::Const::DECLINED;
}
}