view release on metacpan or  search on metacpan

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

use strict;
use warnings;

use Data::Dumper;
use Time::HiRes;
use Apache::Voodoo::Exception;

sub new {
	my $class = shift;
	my $self = {};

	bless $self, $class;

	return $self;
}

sub init { }

################################################################################
# Debugging
################################################################################

sub debug {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->debug(@_);
	}
}

sub info {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->info(@_);
	}
}

sub warn {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->warn(@_);
	}
}

sub error {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->error(@_);
	}
}

sub exception {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->exception(@_);
	}
	Apache::Voodoo::Exception::RunTime::Thrown->throw(join("\n",@_));
}

sub trace {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->trace(@_);
	}
}

sub table {
	my $self = shift;

	if (ref($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->table(@_);
	}
}

sub mark {
	my $self = shift;

	if (defined($Apache::Voodoo::Engine::debug)) {
		$Apache::Voodoo::Engine::debug->mark(Time::HiRes::time, @_);
	}
}

################################################################################
# Behavior control
################################################################################

sub set_view {
	$_[1]->{_view_} = $_[2];
}

sub stop_chain {
	$_[1]->{_stop_chain_} = 1;
}

sub redirect {
	shift;
	Apache::Voodoo::Exception::Application::Redirect->throw(target => shift);
}

sub display_error {
	shift;
	my ($c,$e,$t);
	if (@_ == 3) {
		($c,$e,$t) = @_;
	}
	elsif (@_ >= 2 && $_[0] =~ /^\s*[\w:\.-]+\s*$/) {
		$c = shift;
		$e = shift;
		$t = shift || '/index';
	}
	else {
		$c = '500';
		$e = shift;
		$t = shift || '/index';
	}

	if (ref($t)) {
		Apache::Voodoo::Exception::Application::DisplayError->throw(
			code   => $c,
			error  => $e,
			detail => $t
		);
	}
	else {
		Apache::Voodoo::Exception::Application::DisplayError->throw(
			code   => $c,
			error  => $e,
			target => $t
		);
	}
}

sub access_denied {
	shift;
	my $m = shift || "Access Denied";
	my $t = shift || "/access_denied";

	if (ref($t)) {
		Apache::Voodoo::Exception::Application::AccessDenied->throw(
			error  => $m,
			detail => $t
		);
	}
	else {
		Apache::Voodoo::Exception::Application::AccessDenied->throw(
			error  => $m,
			target => $t
		);
	}
}

sub raw_mode {
	my ($self,$c,$d,$h) = @_;
	Apache::Voodoo::Exception::Application::RawData->throw(
		"content_type" => $c,
		"data"         => $d,
		"headers"      => $h
	);
}

sub history {
	my $self = shift;
	my $session = shift;
	my $index = shift;

	return $session->{'history'}->[$index]->{'uri'}.'?'.$session->{'history'}->[$index]->{'params'};
}

sub tardis {
	my $self = shift;
	my $p = shift;

	my %targets = map { $_ => 1 } @_;

	my $history = $p->{'session'}->{'history'};

	for (my $i=0; $i <= $#{$history}; $i++) {
		if ($targets{$history->[$i]->{'uri'}}) {
			return $self->redirect($self->history($p->{'session'},$i));
		}
	}

	return $self->redirect($self->history($p->{'session'},1));
}

################################################################################
# Text Manipulation
################################################################################

sub mkurlparams {
	my $self = shift;
	my $h    = shift;
	my $o    = shift || {};

	# keep track of what keys out of $o we've used in a non-destructive
	# way to the original structure;
	my %used;

	my @return;
	foreach my $key (keys %{$h}) {
		next if exists($o->{$key});

		# if this key is in $o then we use it's values instead of those in $h
		if (defined($o->{$key})) {
			if (ref($o->{$key})) {
				push(@return, map { "$key=$_" } @{$o->{$key}} );
			}
			else {
				push(@return,"$key=$o->{$key}") if length($o->{$key});
			}

			$used{$key} = 1;
		}
		else {