1 # This file was initially taken from Cricket, and reworked later
3 # Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
4 # Copyright (C) 2002 Stanislav Sinyagin
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
20 # $Id: Log.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
21 # Stanislav Sinyagin <ssinyagin@yahoo.com>
23 # 2002/06/25 11:35:00 ssinyagin
24 # Taken from Cricket lib/Common/Log.pm
26 # 2004/06/25 ssinyagin
27 # Finally reworked in 2 years!
35 our @ISA = qw(Exporter);
37 our @EXPORT = qw(Debug Warn Info Error Verbose isDebug);
39 my @monthNames = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
40 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
49 my $currentLogLevel = $logLevel{'info'};
53 my( $level, @msg ) = @_;
55 $level = $logLevel{$level};
57 if( $level <= $currentLogLevel )
59 my $severity = ( $level <= $logLevel{'warn'} ) ? '*' : ' ';
60 printf STDERR ( "[%s%s] %s\n",
61 timeStr( time() ), $severity, join( '', @msg ) );
95 Log( 'debug', $$ . '.' . $TID . ' ', join('|', @_) );
101 return $currentLogLevel >= $logLevel{'debug'};
108 my( $sec, $min, $hour, $mday, $mon, $year) = localtime( $t );
110 return sprintf('%02d-%s-%04d %02d:%02d:%02d',
111 $mday, $monthNames[$mon], $year + 1900, $hour, $min, $sec);
116 my $level = lc( shift );
118 if( defined( $logLevel{$level} ) )
120 $currentLogLevel = $logLevel{$level};
124 Error("Log level name '$level' unknown. Defaulting to 'info'");
125 $currentLogLevel = $logLevel{'info'};
133 # indent-tabs-mode: nil
135 # perl-indent-level: 4