view release on metacpan or  search on metacpan

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

	}
}

sub exception {
	my $self = shift;
	my $e    = shift;

	my $d;

	if ($e->isa("Exception::Class::DBI")) {
		$d = {
			"description" => "Database Error",
			"message"     => $e->errstr,
			"package"     => $e->package,
			"line"        => $e->line,
			"query"       => $self->_format_query($e->statement)
		};
	}
	elsif ($e->isa("Apache::Voodoo::Exception::RunTime")) {
		$d = {
			"description" => $e->description,
			"message"     => $e->error,
			"stack"       => $self->_stack_trace($e->trace())
		};
	}
	else {
		$d = {
			"description" => ref($e),
			"message" => "$e"
		};
	}

	$d->{'success'} = 0;
	$d->{'error'}   = 1;

	$self->{data} = $d;
}

sub output {
	my $self = shift;

	return scalar($self->{json}->to_json($self->{data}));
}

sub finish {
	my $self = shift;

	$self->{data} = {};
}

sub _stack_trace {
	my $self  = shift;
	my $trace = shift;

	unless (ref($trace) eq "Devel::StackTrace") {
		return [];
	}

	my @trace;
	my $i = 1;
	while (my $frame = $trace->frame($i++)) {
		last if ($frame->package =~ /^Apache::Voodoo::Engine/);
		next if ($frame->package =~ /^Apache::Voodoo/);
		next if ($frame->package =~ /(eval)/);

		my $f = {
			'class'    => $frame->package,
			'function' => $trace->frame($i)->subroutine,
			'file'     => $frame->filename,
			'line'     => $frame->line,
		};
		$f->{'function'} =~ s/^$f->{'class'}:://;

		my @a = $trace->frame($i)->args;
		# if the first item is a reference to same class, then this was a method call
		if (ref($a[0]) eq $f->{'class'}) {
			shift @a;
			$f->{'type'} = '->';
		}
		else {
			$f->{'type'} = '::';
		}
		$f->{'args'} = \@a;

		push(@trace,$f);

	}
	return \@trace;
}

sub _format_query {
	my $self  = shift;
	my $query = shift;

	my $leading = undef;
	my @lines;
	foreach my $line (split(/\n/,$query)) {
		$line =~ s/[\r\n]//g;
		$line =~ s/(?<![ \S])\t/    /g;    # negative look-behind assertion.  replaces only leading tabs

		if (!defined($leading)) {
			next if $line =~ /^\s*$/;
			my $l = $line;
			$l =~ s/\S.*$//;
			if (length($l)) {
				$leading = length($l);
			}
		}
		else {
			my $l = $line;
			$l =~ s/\S.*$//;
			if (length($l) and length($l) < $leading) {
				$leading = length($l);
			}
		}
		push (@lines,$line);
	}

	return join(
		"\n",
		map {
			$_ =~ s/^ {$leading}//;
			$_;
		} @lines
	);
}

1;

################################################################################
# Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org).
# All rights reserved.
#
# You may use and distribute Apache::Voodoo under the terms described in the