Line # Revision Author
1 8 ahitrov@rambler.ru package Contenido::Msg;
2
3 use strict;
4 use warnings;
5
6 use Contenido::Globals;
7
8 use vars qw (@EXPORT @ISA %HANDLERS);
9
10 require Exporter;
11 @ISA = qw(Exporter);
12
13 @EXPORT = qw(&msg);
14
15 #никогда не ставьте вызовы &debug в код log_handlers
16 %HANDLERS = (
17 debug => \&default_warn_handler,
18 log => \&default_warn_handler,
19 logging => \&default_warn_handler,
20 warn => \&default_warn_handler,
21 warning => \&default_warn_handler,
22 err => \&default_warn_handler,
23 error => \&default_warn_handler,
24 crit => \&default_warn_handler,
25 sql => \&default_sql_handler,
26 );
27
28 sub msg {
29 my ($msg, $tag) = @_;
30 $tag = lc($tag);
31
32 #нет handler на такой тип сообщения или кривой handler стоит
33 unless ($tag and exists($HANDLERS{$tag}) and (ref($HANDLERS{$tag}) eq 'CODE')) {
34 warn "не известный или некорректный handler для сообщения типа: '$tag'\n";
35 return undef;
36 }
37
38 my ($package, $filename, $line) = caller();
39 my @caller = caller(1);
40 my $subroutine;
41
42 if ( $caller[3] =~ /::(\w+)$/ ) {
43 $subroutine = $1;
44 } else {
45 $subroutine = caller[3];
46 }
47
48 #формируем строку об ошибке в стандартном формате
49 my $string = 'Contenido '.$tag.' ['.scalar(localtime).'] '.$$.': '.$package.'/'.$line.' '.$subroutine.': '.$msg;
50
51 #вызываем handler обработки сообщения
52 eval { $HANDLERS{$tag}->($string, $tag) };
53 warn "Error $@ in handler $tag\n" if ($@);
54 }
55
56 sub default_warn_handler {
57 my ($string, $tag) = @_;
58 #пропускаем если тип сообщения debug и отладка выключенна
59 warn $string."\n" unless ($tag eq 'debug' and !$DEBUG);
60 }
61
62 sub default_sql_handler {
63 my ($string, $tag) = @_;
64 #только для $DEBUG_SQL установленного
65 warn $string."\n" if ($DEBUG_SQL);
66 }
67
68 1;
69