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;