view release on metacpan or  search on metacpan

lib/Apache/Voodoo/Test.pm  view on Meta::CPAN

$VERSION = "3.0200";

use strict;

use Time::HiRes;
use File::Spec;

use Apache::Voodoo::Constants;
use Apache::Voodoo::Engine;

sub new {
	my $class = shift;
	my %opts  = @_;

	die "id is a required parameter" unless $opts{'id'};

	my $self = {};
	bless $self, $class;

	$self->{'id'} = $opts{'id'};

	$self->{'constants'} = Apache::Voodoo::Constants->new();

	# If they've specified an alternate config file for testing,
	# reach behind the scenes and make the engine look for it intead.
	$self->{'constants'}->{'CONF_FILE'} = $opts{'config_file'} if ($opts{'config_file'});

	$self->{'engine'} = Apache::Voodoo::Engine->new(
		'mp'         => $self,
		'only_start' => $opts{'id'},
		'constants'  => $self->{'constants'}
	);

	$self->{'engine'}->init_app();
	$self->{'engine'}->begin_run();

	# FIXME: Hack to prefer my extended version of Pod::WSDL over the
	# one on CPAN.  This will need to stay in place until either the
	# author of Pod::WSDL replys or I release my own version.
	$self->{'pwsdl'} = undef;
	eval {
		require Pod::WSDL2;
		$self->{'pwsdl'} = 'Pod::WSDL2';
	};
	if ($@) {
		eval {
			require Pod::WSDL;
			$self->{'pwsdl'} = 'Pod::WSDL';
		};
	}

	return $self;
}

sub make_request {
	my $self   = shift;

	$self->set_request();

	if ($_[0] =~ /^(GET|POST|PUT|DELETE)$/) {
		$self->method(shift);
		$self->uri(shift);
	}
	else {
		$self->method('GET');
		$self->uri(shift);
	}

	$self->parameters(@_);

	####################
	# URI translation jazz to get down to a proper filename
	####################
	my $uri = $self->uri();
	if ($uri =~ /\/$/o) {
		return $self->redirect($uri."index");
	}

	my $filename = $self->filename();

	# remove the optional trailing .tmpl
	$filename =~ s/\.tmpl$//o;
	$uri      =~ s/\.tmpl$//o;

	unless (-e "$filename.tmpl") { return $self->declined;  }
	unless (-r "$filename.tmpl") { return $self->forbidden; }

	####################
	# Get paramaters
	####################
	my $params;
	eval {
		$params = $self->{'engine'}->parse_params();
	};
	if (my $e = Exception::Class->caught()) {
		warn "$e";
		$self->server_error;
	}

	####################
	# History capture
	####################
	if ($self->is_get         &&
		!$params->{ajax_mode} &&
		!$params->{return}
		) {
		$self->{'engine'}->history_capture($uri,$params);
	}

	####################
	# Execute the controllers
	####################
	my $content;
	eval {
		$content = $self->{'engine'}->execute_controllers($uri,$params);
	};
	if (my $e = Exception::Class->caught()) {
		if ($e->isa("Apache::Voodoo::Exception::Application::Redirect")) {
			$self->{'engine'}->status($self->redirect);
			return $self->redirect($e->target());