Revision 8 (by ahitrov@rambler.ru, 2010/03/29 11:46:38) |
Contenido UTF-8 core files
|
##############################################################################
# $HeadURL$
# $Id$
#
# Перегрузка builtin функций 'warn' и 'die'.
# Использование:
# use Contenido::Errors qw(die warn);
# При включенной опции STACK_TRACE = YES ($state->{stack_trace} в config.mk
# инсталляции дополняет выводимые сообщения трейсом по компонентам и модулям.
##############################################################################
package Contenido::Errors;
use strict;
use warnings 'all';
use base qw(Exporter);
use vars qw(@EXPORT_OK);
use Contenido::Globals;
@EXPORT_OK = qw(&debug &die &warn);
my %skip_pack = map {$_=>1} qw(
HTML::Mason::ApacheHandler
HTML::Mason::Component
HTML::Mason::Request
HTML::Mason::Request::ApacheHandler
);
my %skip_file = map {$_=>1} qw(
/dev/null
);
sub debug {
return unless $DEBUG;
warn("DEBUG: ".join("\n", @_));
}
sub warn {
my $msg = (@_ ? join("\n", @_) : 'Warning: something\'s wrong').&native(@_);
$msg .= &trace if $state->{stack_trace};
CORE::warn $msg;
}
sub die {
my $msg = (@_ ? join("\n", @_) : 'Died').&native(@_);
$msg .= &trace if $state->{stack_trace};
CORE::die $msg;
}
sub native {
return '' if ($_[-1]||'')=~/\n$/;
my @info = caller(1);
" at ".$info[1]." line ".$info[2].", in PID $$, ".(localtime(time))."\n";
}
sub trace {
my (@stack, @info, $level);
while (@info = caller(++$level)) {
next if $skip_pack{$info[0]} || $skip_file{$info[1]};
push @stack, sprintf(' line: %6d file: %s', $info[2], $info[1]);
}
@stack ? "Stack trace:\n".join("\n", @stack)."\n" : '';
}
1;