view release on metacpan or  search on metacpan

lib/Web/App/Request.pm  view on Meta::CPAN

	try_to_use ($pack) || die;
	
	$pack->_preload ($app)
		if $pack->can ('_preload');
	
}

sub new {
	my $class = shift;
	my $app   = shift;
	
	my $request = {
		processors => [],
		presenter => {},
	};
	
	debug ">>>>>>>>>>>>>>>> request handling <<<<<<<<<<<<<<<<";
	
	my $pack = &detect_package;
	
	try_to_use ($pack) || die;
	
	bless $request, $pack;
	
	$request->_init ($app)
		if $request->can ('_init');
	
	return $request;
}

sub process {
	my $self = shift;
	
	my $app = Web::App::Core->instance;
	
	my $response = Web::App::Response->new;
	
	my $screen_class = $app->screen_class;
	
	my $screen = $screen_class->for_request ($self);
	
	unless (defined $screen) {
		$screen = $screen_class->for_code (404);
		unless (defined $screen) {
			# we must have check for main screen during Screen init procedure
			# if not, this error appears on most error screens
			$screen = $screen_class->main_screen;
		}
	}
	
	if ($screen->auth) {
		my $session = Web::App::Session->new ($self);
		$screen = $screen_class->for_code (403)
			unless $session->authorized ($screen);
		
		return $self->present_and_transmit;
	}
	
	my $commands = $screen->commands;
	
	# TODO: coroutines
	
	my $get_through = "get_through_parallel";
	if (1 || $app->config->{no_coro}) {
		$get_through = "get_through";
	}
	
	# real request state change occurs if codes
	# 302/303, 401, 403, 404, 5xx received
	my $http_code = $self->$get_through ($screen->commands);
	
	if ($http_code >= 300) {
		# sometimes error screens have additional processing
		$screen = $screen_class->for_code ($response->http_code);
		
		# if we have error even when processing error screen, god bless america
		$self->$get_through ($screen->commands);
	}
	
	$self->present_and_transmit;
}

sub get_through { # screen queue
	my $self  = shift;
	my $queue = shift;
	
	my $response_data = $self->response->data;
	
	my $processing = $queue;
	
	if (ref $queue->[0] ne 'ARRAY') { # we assume command objects
		$processing = [$queue];
	}
	
	foreach my $processing_queue (@$processing) {
		foreach my $command (@$processing_queue) {
			my ($http_code, $data) = ($command->run);
			$response_data->{$command->response_slot} = $data
				if defined $data;
			
			return $http_code
				if $http_code != 200 and $command->important;
		}
	}
	
	return 200;
}

sub present_and_transmit {
	my $self = shift;
	
	my $document = $self->presentation ($self->response);
	
	$self->transmit ($document);
}

sub detect_package {
	my $pack = 'Web::App::Request';
	# environment is our way to check for available request modes
	if (exists $ENV{MOD_PERL}) {
		$pack = 'Web::App::Request::ModPerl';
	} elsif (exists $ENV{QUERY_STRING}) {
		$pack = 'Web::App::Request::CGI';
	} else {