view release on metacpan or  search on metacpan

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

			return $self->redirect($e->target());
		}
		elsif ($e->isa("Apache::Voodoo::Exception::Application::RawData")) {
			$self->header_out(each %{$e->headers}) if (ref($e->headers) eq "HASH");
			$self->content_type($e->content_type);
			$self->print($e->data);

			$self->{'engine'}->status($self->ok);
			return $self->ok;
		}
		elsif ($e->isa("Apache::Voodoo::Exception::Application::Unauthorized")) {
			$self->{'engine'}->status($self->unauthorized);
			return $self->unauthorized;
		}
		elsif (! $e->isa("Apache::Voodoo::Exception::Application")) {
			# Apache::Voodoo::Exception::RunTime
			# Apache::Voodoo::Exception::RunTime::BadCommand
			# Apache::Voodoo::Exception::RunTime::BadReturn
			# Exception::Class::DBI
			unless ($self->{'engine'}->is_devel_mode()) {
				warn "$@";
				$self->{'engine'}->status($self->server_error);
				return $self->server_error;
			}

		}
		$content = $e;
	}

	$self->{'controller_output'} = $content;
	my $view = $self->{'engine'}->execute_view($content);

	# output content
	$self->content_type($view->content_type());
	$self->print($view->output());

	####################
	# Clean up
	####################
	$self->{'engine'}->status($self->ok);
	$view->finish();

	return $self->ok;
}

sub get_wsdl {
	my $self = shift;
	my $uri = $self->uri(shift);

	unless ($self->{pwsdl}) {
		$self->content_type('text/plain');
		$self->print("No WSDL generator installed.  Either install Pod::WSDL or Pod::WSDL2");
		return $self->ok;
	}

	# copied straight from Soap.pm
	# FIXME hack.  Shouldn't be looking in there to get this
	$uri =~ s/^\/+//;

	unless ($self->{'engine'}->_app->{'controllers'}->{$uri}) {
		return $self->not_found();
	}

	my $m = ref($self->{'engine'}->_app->{'controllers'}->{$uri});
	if ($m eq "Apache::Voodoo::Loader::Dynamic") {
		$m = ref($self->{'engine'}->_app->{'controllers'}->{$uri}->{'object'});
	}
	# FIXME here ends the hackery

	my $wsdl;
	eval {
		# FIXME the other part of the Pod::WSDL version hack
		$wsdl = $self->{'pwsdl'}->new(
			source   => $m,
			location => $self->server_url().$uri,
			pretty   => 1,
			withDocumentation => 1
		);
		$wsdl->targetNS($self->server_url());
	};
	if ($@) {
		$self->content_type('text/plain');
		$self->print("Error generating WDSL:\n\n$@");
	}
	else {
		$self->content_type('text/xml');
		$self->print($wsdl->WSDL);
	}

	return $self->ok;
}

sub get_dbh {
	my $self = shift;
	return $self->{'engine'}->{'dbh'};
}

sub get_session {
	my $self = shift;
	return $self->{'engine'}->{'session'};
}

sub get_model {
	my $self  = shift;
	my $model = shift;

	return $self->{'engine'}->get_model($self->{'id'},$model);
}

sub set_request {
	my $self = shift;

	$self->{'request_id'} = Time::HiRes::time;

	foreach (qw(uri cookiejar content_type is_get redirected_to controller_output)) {
		delete $self->{$_};
	}

	foreach (qw(err_header_out header_out header_in)) {
		$self->{$_} = [];
	}

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

	if ($_[0] =~ /^(get|post)$/) {
		$self->{'method'} = uc($_[0]);
	}

	return $self->{'method'};
}


sub print {
	my $self = shift;

	$self->{'output'} .= $_[0];
}

sub controller_output {
	my $self = shift;
	return $self->{'controller_output'};
}

sub output {
	my $self = shift;
	return $self->{'output'};
}

sub is_get     { return ($_[0]->method eq "GET"); }
sub get_app_id { return $_[0]->{"id"}; }
sub site_root  { return "/"; }

sub remote_ip {
	my $self = shift;
	$self->{'remote_ip'} = $_[0] if $_[0];
	return $self->{'remote_ip'};
}

sub remote_host {
	my $self = shift;
	$self->{'remote_host'} = $_[0] if $_[0];
	return $self->{'remote_host'};
}

sub server_url {
	return "http://localhost/";
}

sub if_modified_since {
}

sub register_cleanup {
	my $self = shift;

}

sub status { return $_[0]->{'status'}; }

sub declined     { my $self = shift; $self->{'status'} = "DECLINED";      return $self->{'status'}; }
sub forbidden    { my $self = shift; $self->{'status'} = "FORBIDDEN";     return $self->{'status'}; }
sub unauthorized { my $self = shift; $self->{'status'} = "AUTH_REQUIRED"; return $self->{'status'}; }
sub ok           { my $self = shift; $self->{'status'} = "OK";            return $self->{'status'}; }
sub server_error { my $self = shift; $self->{'status'} = "SERVER_ERROR";  return $self->{'status'}; }
sub not_found    { my $self = shift; $self->{'status'} = "NOT_FOUND";     return $self->{'status'}; }

sub content_type {
	my $self = shift;

	$self->{'content_type'} = shift if scalar(@_);
	return $self->{'content_type'};
}

sub err_header_out {
	my $self = shift;

	push(@{$self->{'err_header_out'}},@_) if scalar(@_);
	return $self->{'err_header_out'};
}

sub header_out {
	my $self = shift;

	push(@{$self->{'header_out'}},@_) if scalar(@_);
	return $self->{'header_out'};
}

sub header_in {
	my $self = shift;

	push(@{$self->{'header_in'}},@_) if scalar(@_);
	return $self->{'header_in'};
}

sub redirected_to { return $_[0]->{'redirected_to'}; }
sub redirect {
	my $self = shift;
	my $loc  = shift;

	$self->{'redirected_to'} = $loc;
	$self->{'status'} = "REDIRECT";

	return "REDIRECT";
}

sub parameters {
	my $self = shift;

	if (scalar(@_)) {
		if (scalar(@_) == 1 && ref($_[0]) eq "HASH") {
			$self->{'parameters'} = shift;
		}
		else {
			$self->{'parameters'} = [ @_ ];
		}
	}

	return $self->{'parameters'};
}

sub parse_params {
	my $self       = shift;
	my $upload_max = shift;

	if (ref($self->{'parameters'}) eq "HASH") {