/[meteor]/googlecode.com/svn/trunk/Meteor/Syslog.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /googlecode.com/svn/trunk/Meteor/Syslog.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by andrew.betts, Fri Dec 8 16:52:58 2006 UTC revision 50 by andrew.betts, Wed Feb 27 13:55:35 2008 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2  ###############################################################################  ###############################################################################
3  #   Meteor  #   Meteor
4  #   An HTTP server for the 2.0 web  #   An HTTP server for the 2.0 web
5  #   Copyright (c) 2006 contributing authors  #   Copyright (c) 2006 contributing authors
6  #  #
7  #   Subscriber.pm  #   Subscriber.pm
8  #  #
9  #       Description:  #       Description:
10  #       Convenience interface to syslog  #       Convenience interface to syslog
11  #  #
12  ###############################################################################  ###############################################################################
13  #  #
14  #   This program is free software; you can redistribute it and/or modify it  #   This program is free software; you can redistribute it and/or modify it
15  #   under the terms of the GNU General Public License as published by the Free  #   under the terms of the GNU General Public License as published by the Free
16  #   Software Foundation; either version 2 of the License, or (at your option)  #   Software Foundation; either version 2 of the License, or (at your option)
17  #   any later version.  #   any later version.
18  #  #
19  #   This program is distributed in the hope that it will be useful, but WITHOUT  #   This program is distributed in the hope that it will be useful, but WITHOUT
20  #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or  #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
21  #   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for  #   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
22  #   more details.  #   more details.
23  #  #
24  #   You should have received a copy of the GNU General Public License along  #   You should have received a copy of the GNU General Public License along
25  #   with this program; if not, write to the Free Software Foundation, Inc.,  #   with this program; if not, write to the Free Software Foundation, Inc.,
26  #   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA  #   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27  #  #
28  #   For more information visit www.meteorserver.org  #   For more information visit www.meteorserver.org
29  #  #
30  ###############################################################################  ###############################################################################
31    
32  package Meteor::Syslog;  package Meteor::Syslog;
33  ###############################################################################  ###############################################################################
34    
35          use strict;          use strict;
36          use Sys::Syslog;          use Sys::Syslog;
37                    
38  ###############################################################################  ###############################################################################
39  # Configuration  # Configuration
40  ###############################################################################  ###############################################################################
41    
42          $Meteor::Syslog::DEFAULT_FACILITY='daemon';          $Meteor::Syslog::DEFAULT_FACILITY='daemon';
43                    
44          $Meteor::Syslog::_open=0;               # set to 1 by _open          $Meteor::Syslog::_open=0;               # set to 1 by _open
45                    
46  ###############################################################################  ###############################################################################
47  # Implementation  # Implementation
48  ###############################################################################  ###############################################################################
49  sub ::syslog {  sub ::syslog {
50                    
51          if($::CONF{'Debug'})          my $debug=$::CONF{'Debug'};
52          {          
53                  my $priority=shift;          my $priority=shift;
54                  my $format=shift;          return if($priority eq 'debug' && !$debug);
55                            
56                  $format=~s/\%m/$!/g;          my $format=shift;
57                            my @args=@_;
58                  print STDERR "$::PGM($priority): ";          
59                  print STDERR sprintf($format,@_);          if($format eq '')
60                  print STDERR "\n" unless(substr($format,-1) eq "\n");          {
61                                    my $txt=join("\t",@args);
62                  return;                  $format='%s';
63          }                  @args=($txt);
64          else          }
65          {          
66                  # No expensive syslog calls for debug!          my $facility=$::CONF{'SyslogFacility'} || $Meteor::Syslog::DEFAULT_FACILITY;
67                  return if($_[0] eq 'debug');          
68          }          if($debug || $facility eq 'none')
69                    {
70          unless($Meteor::Syslog::_open)                  $format=~s/\%m/$!/g;
71          {                  
72                  my $facility=$::CONF{'SyslogFacility'} || $Meteor::Syslog::DEFAULT_FACILITY;                  my $time = ($::CONF{'LogTimeFormat'} eq 'unix') ? time : localtime(time);
73                  openlog($::PGM,0,$facility);                  
74                  $Meteor::Syslog::_open=1;                  print STDERR "$time\t$priority\t";
75          }                  print STDERR sprintf($format,@args);
76                            print STDERR "\n" unless(substr($format,-1) eq "\n");
77          syslog(@_);                  
78  }                  return;
79            }
80  sub myWarn {          
81          local $SIG{'__DIE__'}='';          unless($Meteor::Syslog::_open)
82          local $SIG{'__WARN__'}='';          {
83                            my $facility=$::CONF{'SyslogFacility'} || $Meteor::Syslog::DEFAULT_FACILITY;
84          &::syslog('warning',$_[0]);                  openlog($::PGM,0,$facility);
85  }                  $Meteor::Syslog::_open=1;
86            }
87  sub myDie {          
88          local $SIG{'__DIE__'}='';          syslog($priority,$format,@args);
89          local $SIG{'__WARN__'}='';  }
90                    
91          my $inEval=0;  sub myWarn {
92          my $i=0;          local $SIG{'__DIE__'}='';
93          my $sub;          local $SIG{'__WARN__'}='';
94          while((undef,undef,undef,$sub)=caller(++$i))          
95          {          &::syslog('warning',$_[0]);
96                  $inEval=1, last if $sub eq '(eval)';  }
97          }  
98            sub myDie {
99          unless($inEval)          local $SIG{'__DIE__'}='';
100          {          local $SIG{'__WARN__'}='';
101                  &::syslog('err',$_[0]);                  
102                  $Meteor::Socket::NO_WARN_ON_CLOSE=1;          my $inEval=0;
103                  exit;          my $i=0;
104          }          my $sub;
105  }          while((undef,undef,undef,$sub)=caller(++$i))
106            {
107  1;                  $inEval=1, last if $sub eq '(eval)';
108            }
109            
110            unless($inEval)
111            {
112                    &::syslog('err',$_[0]);
113                    $Meteor::Socket::NO_WARN_ON_CLOSE=1;
114                    exit;
115            }
116    }
117    
118    1;
119  ############################################################################EOF  ############################################################################EOF
Legend:
Removed from v.9  
changed lines
  Added in v.50
  ViewVC Help
Powered by ViewVC 1.1.26