dbscripts/lib/log.pl

   1 #!/usr/bin/perl
   2
   3 #
   4 #       Logfile Module (3.6.1998)
   5 #
   6 #       USAGE: tie *HANDLE, 'Logfile', '<filename>', '<modulename';
   7 #
   8 #       $VER: 1.1$
   9 #
  10
  11 package Logfile;
  12
  13 $LOCK_EX=2;
  14 $LOCK_UN=8;
  15
  16 sub mkname {
  17         my($name)=shift;
  18         my @timestr=localtime(time);
  19
  20         $name=~s/\%d/$timestr[3]/eg;
  21         $name=~s/\%m/$timestr[4]+1/eg;
  22         $name=~s/\%y/$timestr[5]+1900/eg;
  23
  24         return $name;
  25         }
  26
  27 # no reading from logfile
  28 sub READLINE { return undef; }
  29 sub READ { return undef; }
  30 sub GETC { return undef; }
  31
  32 sub PRINT {
  33         my $obj=shift;
  34         my @text=@_;
  35         my @timestr=localtime(time);
  36
  37         local(*OUT);
  38
  39         if ((scalar(@text)>1) && ($text[0]=~/^\d+$/)) {
  40                 my($level)=shift(@text);
  41                 return if ($level<$$obj{'loglevel'});
  42                 }
  43
  44         if (open(OUT,">>".$$obj{'filename'})) {
  45                 flock(OUT,$LOCK_EX);
  46                 seek(OUT,0,2);
  47                 printf OUT ("%02d.%02d.%s %02d:%02d:%02d [%d] %s: %s",
  48                 ($timestr[3]),
  49                 ($timestr[4]+1),
  50                 ($timestr[5]+1900),
  51                 $timestr[2],$timestr[1],$timestr[0],
  52                 $$,$$obj{'module'},
  53                 join("",@text));
  54                 flock(OUT,$LOCK_UN);
  55                 close(OUT);
  56                 }
  57         }
  58
  59 sub TIEHANDLE {
  60         my $obj;
  61         shift;
  62         $$obj{'filename'}=&mkname(shift);
  63         $$obj{'module'}=shift;
  64         $$obj{'loglevel'}=(shift || 0);
  65
  66         bless $obj, 'Logfile';
  67
  68         return $obj;
  69         }
  70 1;