|
All,
I'm looking for some help with understanding how the Apache::Request objects are created and destroyed. I have the following params set in my httpd.conf KeepAlive Off PerlChildInitHandler Bficient::Apache::DBload Which as I understand it should mean that an apache::Request object is created for each request, and is destroyed at the end of a request. So if I add 'CREATION and DESTROY' warnings to my Apache::Request code to log when a request is being created and destroyed I should see the objects being created and destroyed as they are used. This would lead me to believe that when I stop apache, the only DESTROY messages I should see are those belonging to the childInitHandler, e.g. I should see my database handles being destroyed. I'm just trying to get an understanding of what 'should' happen, so that I can work out If I have a problem with my code. I have subclassed Apache::Request and I'm seeing my subclassed Apache::Request objects being 'DESTROYED' under an apache stop. AS WELL as after the Request completes, e.g. after the request completes I see this:- $VAR1 = bless( { 'r' => bless( do{\(my $o = 145326836)}, 'Apache::Request' ) }, 'Bficient::Apache::Request' ); DESTROYING Bficient::Apache::Request But when I stop apache I see this:- $VAR1 = bless( { 'r' => undef }, 'Bficient::Apache::Request' ); DESTROYING Bficient::Apache::Request This doesn't look 'right', but I'm not sure. Attached is my Bficient::Apache::Request object, If that helps. Any help, or pointers would be greatly appreciated, kind regards Marty |
############################################################################# #Module to sublass Apache to provide Custom Authorisation mechanisms #Using the Apache::Session objects for each user. #############################################################################
package Bficient::Apache::Request;
use Bficient::Conf;
use lib qw(Bficient::Conf::PERL_LIB_DIR);
use Apache::Constants qw(OK REDIRECT SERVER_ERROR DECLINED FORBIDDEN);
use Apache::Cookie;
use Carp;
use Apache::Reload;
use Apache::Request;
use Bficient::Maketext;
use Data::Dumper;
use base 'Exporter';
use Bficient::DBI;
use Bficient::Apache::DBload qw($bdbh);
use MIME::Base64 qw(encode_base64 decode_base64);
use strict;
@Bficient::Apache::Request::ISA = qw(Apache::Request);
my $lh;
sub new
{
my ($class, $r) = @_;
#unless ($r)
#{
#print STDERR "making a new Request object\n";
#$r = Apache::Request->new;
#}
my $self = bless {r => Apache::Request->new($r)}, $class;
my @params=$self->param();
print STDERR "Here's the Parameters for $class\n";
print STDERR Dumper(@params);
my $lang_id=$self->param('lang_id');
if ($lang_id)
{
#print STDERR "Using language_id of $lang_id\n";
$lh=Bficient::Maketext->get_handle($class,$lang_id);
}
else
{
#print STDERR "Using Default language_id of
Bficient::Conf::DEFAULT_LANGUAGE_ID\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n";
$lh=Bficient::Maketext->get_handle($class,Bficient::Conf::DEFAULT_LANGUAGE_ID);
}
#print STDERR "Creating ".ref($self)."\n";
#$self->interpret_uri;
return $self;
}
sub DESTROY
{
my $self=shift;
print STDERR Dumper($self);
print STDERR "DESTROYING ".ref($self)."\n";
#$self->SUPER->DESTROY();
}
sub current_db_id
{
my $self=shift;
my $db_id;
if($self->param('db_id'))
{
$db_id=$self->param('db_id');
die $self->lh->maketext("Empty database ID string Used in Parameters\n") unless
$db_id;
}
else
{
my $current_plugin=$self->current_plugin;
#print STDERR Dumper($current_plugin);
my $current_plugin_id=$current_plugin->id;
#print STDERR "PluginID='$current_plugin_id'\n";
my
$database=Bficient::Database->new({_load_default_plugin_database=>$current_plugin_id,dbh=>$bdbh,lang_id=>$self->lang_id});
$db_id=$database->id;
}
return $db_id;
}
#sub make_plugin_html
#{
#my $self=shift;
#my $tt_href=shift;
#
#my $html='';
#
#my $db_id=$self->current_db_id;
#
#my $tt_file = Bficient::Conf::FRAMEWORK_TOPBAR_TEMPLATE;
#$tt_file=~s/\/\//\//;
#my $template = Template->new(Bficient::Conf::TT2_CONFIG);
#my @[EMAIL PROTECTED]::Plugin->all({dbh=>$bdbh})};
##print STDERR Dumper (@plugins);
#my @non_admin=();
#foreach my $plugin (@plugins)
#{
#if ($plugin->Name eq Bficient::Conf::ADMIN_PLUGIN_NAME )
#{
#$tt_href->{admin_plugin}=$plugin;
#}
#else
#{
#push @non_admin, $plugin;
#}
#}
#
#$tt_href->{r}=$self;
#$tt_href->[EMAIL PROTECTED];
#$tt_href->{plugin_count}=scalar(@non_admin);
#$tt_href->{current_uri}=$self->uri;;
#
##print STDERR "tt_VARS=\n";
##print STDERR Dumper(%tt_vars);
#
#my $tt_out=$self->process_template($tt_file, $tt_href);
#
#return $tt_out;
#}
sub user_object
{
my $self=shift;
my $session_id=shift;
my $uh;
if ($uh)
{
my $un=$uh->UserName;
#print STDERR "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZHERE IS MY UH for '$un'\n";
#print STDERR Dumper($uh);
print STDERR $lh->maketext("Using Previously Cached user_object for
'\"[_1]\"'\n",$uh->UserName);
}
else
{
$session_id=$self->pnotes("session_id") unless $session_id;
print STDERR $lh->maketext("Loading user_object for '\"[_1]\"'\n",$session_id);
if ($session_id)
{
#print STDERR "Got session_id\n";
$uh=Bficient::User->load_from_session_id({session_id=>$session_id,dbh=>$bdbh});
#$self->pnotes('uh',$uh);
die "Cannot load User Object for $session_id" unless $uh;
}
else
{
die "Cannot load User Object";
return undef;
}
}
return $uh;
}
sub current_plugin
{
my $self=shift;
my $current_plugin;
#my $current_plugin=$self->pnotes("current_plugin");
unless ($current_plugin)
{
my $plugin_name=$self->pnotes("current_plugin_name");
if ($plugin_name)
{
$current_plugin=Bficient::Plugin->new({_load_by_name=>$plugin_name,
dbh=>$bdbh,lang_id=>$self->lang_id});
}
else
{
die "Current Plugin name not set in Multiplexer - '$plugin_name'";
}
}
return $current_plugin;
}
sub url_id
{
my $self=shift;
my $id=shift;
if ($id)
{
$self->pnotes("bficient_id",$id);
$self->{_url_id}=$id;
return $id;
}
else
{
print STDERR "Getting ID from path_info........";
my $id;
$id=$self->{_url_id};
print STDERR "'$id'\n";
$id=$self->pnotes("bficient_id") unless $id;
print STDERR "'$id'\n";
return $id if ($id || exists($self->{_got_id}));
$self->interpret_uri();
$id=$self->pnotes("bficient_id");
$self->{_url_id}=$id;
$self->{_got_id}=1;
print STDERR "'$id'\n";
return $id;
}
}
sub url_task
{
my $self=shift;
my $task=shift;
if ($task)
{
$self->pnotes("bficient_task",$task);
$self->{_url_task}=$task;
return $task;
}
else
{
my $task=$self->{_url_task};
$task=$self->pnotes("bficient_task") unless $task;
$task=$self->param('task') unless $task;
return $task if ($task || exists($self->{_got_task}));
$self->interpret_uri();
$task=$self->pnotes("bficient_task");
$self->{_url_task}=$task;
$self->{_got_task}=1;
return $task;
}
}
sub interpret_uri
{
my $self=shift;
my $uri=$self->uri;
my $path_info=$self->path_info;
#print STDERR "Interpreting URL - URI=$uri, path_info=$path_info\n";
$uri=~s/$path_info$//;
$uri=~s/\/$//;
$uri.='/';
print STDERR "PATH=$path_info\n";
$path_info=~s/\/$//;
print STDERR "PATH=$path_info\n";
$path_info=~s/^\/*//;
print STDERR "PATH=$path_info\n";
my $id;
my $task;
print STDERR "Grrrrrrrrrrr URI=$uri, path_info=$path_info\n";
my @tmp=split /\//,$path_info;
#print STDERR Dumper(@tmp);
if ($#tmp > 1)
{
die $lh->maketext("Something is a little weird, should only be 2 elements (0 & 1)
in path_info '\"[_1]\"'\n",$path_info);
}
elsif ($#tmp ==1)
{
$id=pop @tmp;
$task=pop @tmp;
if ($id)
{
unless ($id =~ /^\d\d*$/)
{
die $lh->maketext("1 Hmmmmm I seem to have a non digit char in my id
'\"[_1]\"'\n",$id);
}
}
if ($task)
{
unless ($task =~ /^\w\w*$/)
{
die $lh->maketext("2 Hmmmmm I seem to have a non word char in my task
'\"[_1]\"'\n",$task);
}
}
}
elsif($#tmp ==0)
{
$id=pop @tmp;
if ($id)
{
if ($id =~/\d\d*$/)
{
print STDERR $lh->maketext("No task specified, Url's default task will be
used, using id of '\"[_1]\"'\n",$id);
}
else
{
$task=$id;
$id=undef;
}
}
else
{
die $lh->maketext("Path_info is garbled cannot parse Path_info
'\"[_1]\"'\n",$path_info);
}
}
else
{
$id=pop @tmp;
if ($id)
{
if($id=~/\d\d*$/)
{
print STDERR $lh->maketext("No task specified, using class's Default - No
worries\n");
$task=undef;
}
else
{
$task=$id;
$id=undef;
}
}
else
{
print STDERR $lh->maketext("Path_info is blank\n");
#print STDERR Dumper($path_info);
$id=undef;
$task=undef;
}
}
print STDERR $lh->maketext("id = '[_1]', and task = '[_2]'\n",$id,$task);
$self->{_url_id}=$id;
$self->{_url_task}=$task;
$self->pnotes('bficient_id',$id);
$self->pnotes('bficient_task',$task);
return ($uri,$task,$id);
}
#sub process_template
#{
#my ($self,$tt_filename, $tt_href) = @_;
#
#$tt_filename.='.'.$self->lang_id;
#$tt_filename=~s/\/\//\//;
#
#print STDERR "Template = $tt_filename\n";
#my $template = Template->new(Bficient::Conf::TT2_CONFIG);
#
#my $tt_out;
#$template->process($tt_filename, $tt_href, \$tt_out) || do {
#$self->log_reason($template->error());
#return SERVER_ERROR;
#};
#
#return $tt_out;
#}
sub lang_id
{
my $self=shift;
my $mod=ref($lh);
my @code=split /\:\:/, $mod;;
my $code=pop @code;
return $code;
}
1;
