torrus/perllib/Torrus/Log.pm

   1 #    This file was initially taken from Cricket, and reworked later
   2 #
   3 #    Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
   4 #    Copyright (C) 2002  Stanislav Sinyagin
   5 #
   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.
  10 #
  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.
  15 #
  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.
  19
  20 # $Id: Log.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
  21 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  22
  23 # 2002/06/25 11:35:00  ssinyagin
  24 # Taken from Cricket lib/Common/Log.pm
  25 #
  26 # 2004/06/25 ssinyagin
  27 # Finally reworked in 2 years!
  28 #
  29
  30 package Torrus::Log;
  31
  32 use strict;
  33
  34 require Exporter;
  35 our @ISA = qw(Exporter);
  36
  37 our @EXPORT = qw(Debug Warn Info Error Verbose isDebug);
  38
  39 my @monthNames = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
  40                    'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
  41
  42 my %logLevel = (
  43                 'debug'    => 9,
  44                 'verbose'  => 8,
  45                 'info'     => 7,
  46                 'warn'     => 5,
  47                 'error'    => 1 );
  48
  49 my $currentLogLevel = $logLevel{'info'};
  50
  51 sub Log
  52 {
  53     my( $level, @msg ) = @_;
  54
  55     $level = $logLevel{$level};
  56
  57     if( $level <= $currentLogLevel )
  58     {
  59         my $severity = ( $level <= $logLevel{'warn'} ) ? '*' : ' ';
  60         printf STDERR ( "[%s%s] %s\n",
  61                         timeStr( time() ), $severity, join( '', @msg ) );
  62     }
  63     return undef;
  64 }
  65
  66
  67 sub Error
  68 {
  69     Log( 'error', @_ );
  70 }
  71
  72 sub Warn
  73 {
  74     Log( 'warn', @_);
  75 }
  76
  77 sub Info
  78 {
  79     Log( 'info', @_ );
  80 }
  81
  82 sub Verbose
  83 {
  84     Log( 'verbose', @_ );
  85 }
  86
  87 our $TID = 0;
  88 sub setTID
  89 {
  90     $TID = shift;
  91 }
  92
  93 sub Debug
  94 {
  95     Log( 'debug', $$ . '.' . $TID . ' ', join('|', @_) );
  96 }
  97
  98
  99 sub isDebug
 100 {
 101     return $currentLogLevel >= $logLevel{'debug'};
 102 }
 103
 104 sub timeStr
 105 {
 106     my $t = shift;
 107
 108     my( $sec, $min, $hour, $mday, $mon, $year) = localtime( $t );
 109
 110     return sprintf('%02d-%s-%04d %02d:%02d:%02d',
 111                    $mday, $monthNames[$mon], $year + 1900, $hour, $min, $sec);
 112 }
 113
 114 sub setLevel
 115 {
 116     my $level = lc( shift );
 117
 118     if( defined( $logLevel{$level} ) )
 119     {
 120         $currentLogLevel = $logLevel{$level};
 121     }
 122     else
 123     {
 124         Error("Log level name '$level' unknown. Defaulting to 'info'");
 125         $currentLogLevel = $logLevel{'info'};
 126     }
 127 }
 128
 129 1;
 130
 131 # Local Variables:
 132 # mode: perl
 133 # indent-tabs-mode: nil
 134 # tab-width: 4
 135 # perl-indent-level: 4
 136 # End: