view release on metacpan or  search on metacpan

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

				$conf .= "\n";
				close(F);
			}
			else {
				warn $!
			}
		}
		foreach (keys %{$self->{conf}}) {
			$conf .= $_ .' = '.$self->{conf}->{$_}."\n";
		}

		Log::Log4perl->init_once(\$conf);
	}
}

sub enabled {
	return 1;
}


sub debug     { my $self = shift; $self->_get_logger->debug($self->_dumper(@_)); }
sub info      { my $self = shift; $self->_get_logger->info( $self->_dumper(@_)); }
sub warn      { my $self = shift; $self->_get_logger->warn( $self->_dumper(@_)); }
sub error     { my $self = shift; $self->_get_logger->error($self->_dumper(@_)); }
sub exception { my $self = shift; $self->_get_logger->fatal($self->_dumper(@_)); }

sub trace     { my $self = shift; $self->_get_logger->trace($self->_dump_trace(@_)); }
sub table     { my $self = shift; $self->_get_logger->debug($self->_dump_table(@_)); }

sub return_data   { my $self = shift; $self->_get_logger('ReturnData'  )->trace($self->_dumper(@_)); }
sub url           { my $self = shift; $self->_get_logger('Url'         )->trace($self->_dumper(@_)); }
sub status        { my $self = shift; $self->_get_logger('Status'      )->trace($self->_dumper(@_)); }
sub params        { my $self = shift; $self->_get_logger('Params'      )->trace($self->_dumper(@_)); }
sub template_conf { my $self = shift; $self->_get_logger('TemplateConf')->trace($self->_dumper(@_)); }
sub session       { my $self = shift; $self->_get_logger('Session'     )->trace($self->_dumper(@_)); }

sub mark {
	my $self = shift;

	push(@{$self->{profile}},[@_]);
}

sub shutdown {
	my $self = shift;

	my @d = @{$self->{profile}};
	my $last = $#d;
	if ($last > 0) {
		my $total_time = $d[$last]->[0] - $d[0]->[0];

		my @return = map {
			[
				sprintf("%.5f",    $d[$_]->[0] - $d[$_-1]->[0]),
				sprintf("%5.2f%%",($d[$_]->[0] - $d[$_-1]->[0])/$total_time*100),
				$d[$_]->[1]
			]
		} (1 .. $last);

		unshift(@return, [
			sprintf("%.5f",$total_time),
			'percent',
			'message'
		]);

		my $logger = $self->_get_logger("Profile");
		$logger->debug($self->_dump_table("Profile",\@return));
	}

	delete $self->{profile};
}

sub _dumper {
	my $self = shift;
	my @data = @_;
	return sub {
		if (scalar(@data) > 1 || ref($data[0])) {
			# if there's more than one item, or the item we have is a reference
			# then we need to serialize it.
			return Dumper \@data;
		}
		else {
			return $data[0];
		}
	};
}

sub _get_logger {
	my $self    = shift;
	my $section = shift;

	if ($section) {
		return Log::Log4perl->get_logger("Apache::Voodoo::".$section);
	}
	else {
		my @stack = $self->stack_trace();
		if (scalar(@stack)) {
			return Log::Log4perl->get_logger($stack[-1]->{class});
		}
		else {
			return Log::Log4perl->get_logger("Apache::Voodoo");
		}
	}
}

sub _dump_table {
	my $s = shift;
	my @data = @_;

	return sub {
		my $self = $s;
		my $name = "Table";
		if (scalar(@data) > 1) {
			$name = shift @data;
		}

		return "\n$name\n" . $self->_mk_table(@{$data[0]});
	};
}

sub _dump_trace {
	my $s = shift;