view release on metacpan or  search on metacpan

lib/Konstrukt/Handler/Apache.pm  view on Meta::CPAN

	$Konstrukt::Handler->{ENV} = $request->subprocess_env(); #environment
	
	#load environment
	#TODO: needed?
	$request->subprocess_env if MODPERL == 2;
	
	#create myself
	my $self = Konstrukt::Handler::Apache->new(
		$request->document_root(),
		#the apache request returns an absolute filename, but we need the path
		#relatively to the doc root. so we cut off the leading doc root without the trailing slash.
		substr(
			$request->filename(),
			length($request->document_root()) - (substr($request->document_root(), -1, 1) eq '/' ?  1 : 0))
	);
	#the apache request returns the absolute path to the requested file,
	$Konstrukt::Handler->{abs_filename} = $request->filename();
	$Konstrukt::Handler->{filename}     = $Konstrukt::File->relative_path($Konstrukt::Handler->{abs_filename});
	
	#create and initialize request and response objects
	#$request->headers_in():
	#-mod_perl1: List (key => value)
	#-mod_perl2: Tied hash
	$Konstrukt::Request  = Konstrukt::Request->new(uri => $request->uri(), method => $request->method(), headers => MODPERL == 1 ? { ($request->headers_in()) } : { %{$request->headers_in()} });
	#default response
	$Konstrukt::Response = Konstrukt::Response->new(status => '200', headers => { 'Content-Type' => 'text/html' });
	
	#check for file existance
	unless (-e $Konstrukt::Handler->{abs_filename}) {
		$Konstrukt::Debug->debug_message("File '$Konstrukt::Handler->{abs_filename}' not found!");
		return NOT_FOUND;
	}
	
	#stop request overhead time
	$duration_request = time() - $starttime;
	$Konstrukt::Debug->debug_message(sprintf("$Konstrukt::Handler->{filename} request overhead: %.6f seconds.", $duration_request)) if Konstrukt::Debug::INFO;
	
	#generate result
	my $result = $self->process();
	#add debug- and error messages, if any
	if ($Konstrukt::Response->header('Content-Type') eq 'text/html') {
		$result .= "<!--\n" . $Konstrukt::Debug->format_error_messages() . "\n-->\n" if $Konstrukt::Settings->get('handler/show_error_messages');
		$result .= "<!--\n" . $Konstrukt::Debug->format_debug_messages() . "\n-->\n" if $Konstrukt::Settings->get('handler/show_debug_messages');
	}
	#determine content length
	$Konstrukt::Response->header('Content-Length' => length($result));
	
	#set cookies
	foreach my $cookie (keys %{$Konstrukt::Handler->{cookies}}) {
		$request->headers_out->add('Set-Cookie', $Konstrukt::Handler->{cookies}->{$cookie}->as_string());
	}
	
	#set custom headers
	my $headers = $Konstrukt::Response->headers();
	foreach my $field (keys %{$headers}) {
		if (MODPERL == 1) { #weird...
			$request->header_out($field => $headers->{$field});
		} else {
			$request->headers_out->add($field => $headers->{$field});
		}
		#special case for content-type and content-encoding, which have to be defined explicitly
		if ($field eq 'Content-Type') {
			$request->content_type($headers->{$field});
		} elsif ($field eq 'Content-Encoding') {
			$request->content_encoding($headers->{$field});
		}
	}
	
	#set status code
	$request->status($Konstrukt::Response->status());
	#don't cache my dynamic documents!
	$request->no_cache(1);
	#send header. mod_perl 2 does this automatically
	$request->send_http_header() if MODPERL == 1;
	
	#send content
	$request->print($result);
	
	#force session to write its data
	$Konstrukt::Session->release()
		if $Konstrukt::Settings->get('session/use');
	
	#clean up
	#$self->{dbi}->disconnect();
	
	#get status
	my $status = $request->status();
	#must return 0 for status code 200. don't ask me why...
	return $status == 200 ? OK : $status;
}

sub emergency_exit {
	my $self = (@_);
	
	my $request = $Konstrukt::Handler::APACHE_REQUEST;
	
	$request->content_type('text/plain');
	$request->no_cache(1);
	if ($Konstrukt::Settings->get('handler/show_error_messages') or $Konstrukt::Settings->get('handler/show_debug_messages')) {
		#print out debug- and error messages
		$request->status(200);
		$request->send_http_header() if MODPERL == 1;
		
		$request->print("A critical error occurred while processing this request.\nThe request has been aborted.\n\n");
		$request->print($Konstrukt::Debug->format_error_messages()) if $Konstrukt::Settings->get('handler/show_error_messages');
		$request->print($Konstrukt::Debug->format_debug_messages()) if $Konstrukt::Settings->get('handler/show_debug_messages');
	} else {
		$request->status(500);
	}
	
	warn "A critical error occurred while processing this request. The request has been aborted";
	exit;
}

1;

=head1 AUTHOR

Copyright 2006 Thomas Wittek (mail at gedankenkonstrukt dot de). All rights reserved. 

This document is free software.