Line # Revision Author
1 3 ahitrov@rambler.ru ##############################################################################
2 # $HeadURL$
3 # $Id$
4 #
5 # ���������� builtin ������� 'warn' � 'die'.
6 # �������������:
7 # use Contenido::Errors qw(die warn);
8 # ��� ���������� ����� STACK_TRACE = YES ($state->{stack_trace} � config.mk
9 # ����������� ��������� ��������� ��������� ������� �� ����������� � �������.
10 ##############################################################################
11 package Contenido::Errors;
12
13 use strict;
14 use warnings 'all';
15 use base qw(Exporter);
16 use vars qw(@EXPORT_OK);
17
18 use Contenido::Globals;
19
20
21 @EXPORT_OK = qw(&debug &die &warn);
22
23 my %skip_pack = map {$_=>1} qw(
24 HTML::Mason::ApacheHandler
25 HTML::Mason::Component
26 HTML::Mason::Request
27 HTML::Mason::Request::ApacheHandler
28 );
29
30 my %skip_file = map {$_=>1} qw(
31 /dev/null
32 );
33
34 sub debug {
35 return unless $DEBUG;
36 warn("DEBUG: ".join("\n", @_));
37 }
38
39 sub warn {
40 my $msg = (@_ ? join("\n", @_) : 'Warning: something\'s wrong').&native(@_);
41 $msg .= &trace if $state->{stack_trace};
42 CORE::warn $msg;
43 }
44
45 sub die {
46 my $msg = (@_ ? join("\n", @_) : 'Died').&native(@_);
47 $msg .= &trace if $state->{stack_trace};
48 CORE::die $msg;
49 }
50
51 sub native {
52 return '' if ($_[-1]||'')=~/\n$/;
53 my @info = caller(1);
54 " at ".$info[1]." line ".$info[2].", in PID $$, ".(localtime(time))."\n";
55 }
56
57 sub trace {
58 my (@stack, @info, $level);
59
60 while (@info = caller(++$level)) {
61 next if $skip_pack{$info[0]} || $skip_file{$info[1]};
62 push @stack, sprintf(' line: %6d file: %s', $info[2], $info[1]);
63 }
64
65 @stack ? "Stack trace:\n".join("\n", @stack)."\n" : '';
66 }
67
68 1;