home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Syslog.pm < prev    next >
Encoding:
Perl POD Document  |  2003-09-27  |  4.2 KB  |  182 lines
  1. package Log::Dispatch::Syslog;
  2.  
  3. use strict;
  4.  
  5. use Log::Dispatch::Output;
  6.  
  7. use base qw( Log::Dispatch::Output );
  8.  
  9. use Params::Validate qw(validate SCALAR);
  10. Params::Validate::validation_options( allow_extra => 1 );
  11.  
  12. use Sys::Syslog ();
  13.  
  14. # This is old school!
  15. require 'syslog.ph' if $] < 5.006;
  16.  
  17. use vars qw[ $VERSION ];
  18.  
  19. $VERSION = sprintf "%d.%02d", q$Revision: 1.18 $ =~ /: (\d+)\.(\d+)/;
  20.  
  21. 1;
  22.  
  23. sub new
  24. {
  25.     my $proto = shift;
  26.     my $class = ref $proto || $proto;
  27.  
  28.     my %p = @_;
  29.  
  30.     my $self = bless {}, $class;
  31.  
  32.     $self->_basic_init(%p);
  33.     $self->_init(%p);
  34.  
  35.     return $self;
  36. }
  37.  
  38. sub _init
  39. {
  40.     my $self = shift;
  41.  
  42.     my %p = validate( @_, { ident    => { type => SCALAR,
  43.                       default => $0 },
  44.                 logopt   => { type => SCALAR,
  45.                       default => '' },
  46.                 facility => { type => SCALAR,
  47.                       default => 'user' },
  48.                 socket   => { type => SCALAR,
  49.                       default => 'unix' },
  50.               } );
  51.  
  52.     $self->{ident}    = $p{ident};
  53.     $self->{logopt}   = $p{logopt};
  54.     $self->{facility} = $p{facility};
  55.     $self->{socket}   = $p{socket};
  56.  
  57.     $self->{priorities} = [ 'DEBUG',
  58.                 'INFO',
  59.                 'NOTICE',
  60.                 'WARNING',
  61.                 'ERR',
  62.                 'CRIT',
  63.                 'ALERT',
  64.                 'EMERG' ];
  65.  
  66.     Sys::Syslog::setlogsock $self->{socket};
  67. }
  68.  
  69. sub log_message
  70. {
  71.     my $self = shift;
  72.     my %p = @_;
  73.  
  74.     my $pri = $self->_level_as_number($p{level});
  75.  
  76.     Sys::Syslog::openlog($self->{ident}, $self->{logopt}, $self->{facility});
  77.     Sys::Syslog::syslog($self->{priorities}[$pri], '%s', $p{message});
  78.     Sys::Syslog::closelog;
  79. }
  80.  
  81. __END__
  82.  
  83. =head1 NAME
  84.  
  85. Log::Dispatch::Syslog - Object for logging to system log.
  86.  
  87. =head1 SYNOPSIS
  88.  
  89.   use Log::Dispatch::Syslog;
  90.  
  91.   my $file = Log::Dispatch::Syslog->new( name      => 'file1',
  92.                                          min_level => 'info',
  93.                                          ident     => 'Yadda yadda' );
  94.  
  95.   $file->log( level => 'emerg', message => "Time to die." );
  96.  
  97. =head1 DESCRIPTION
  98.  
  99. This module provides a simple object for sending messages to the
  100. system log (via UNIX syslog calls).
  101.  
  102. =head1 METHODS
  103.  
  104. =over 4
  105.  
  106. =item * new(%p)
  107.  
  108. This method takes a hash of parameters.  The following options are
  109. valid:
  110.  
  111. =over 8
  112.  
  113. =item * name ($)
  114.  
  115. The name of the object.  Required.
  116.  
  117. =item * min_level ($)
  118.  
  119. The minimum logging level this object will accept.  See the
  120. Log::Dispatch documentation for more information.  Required.
  121.  
  122. =item * max_level ($)
  123.  
  124. The maximum logging level this obejct will accept.  See the
  125. Log::Dispatch documentation for more information.  This is not
  126. required.  By default the maximum is the highest possible level (which
  127. means functionally that the object has no maximum).
  128.  
  129. =item * ident ($)
  130.  
  131. This string will be prepended to all messages in the system log.
  132. Defaults to $0.
  133.  
  134. =item * logopt ($)
  135.  
  136. A string containing the log options (separated by any separator you
  137. like).  Valid options are 'cons', 'pid', 'ndelay', and 'nowait'.  See
  138. the openlog(3) and Sys::Syslog docs for more details.  I would suggest
  139. not using 'cons' but instead using Log::Dispatch::Screen.  Defaults to
  140. ''.
  141.  
  142. =item * facility ($)
  143.  
  144. Specifies what type of program is doing the logging to the system log.
  145. Valid options are 'auth', 'authpriv', 'cron', 'daemon', 'kern',
  146. 'local0' through 'local7', 'mail, 'news', 'syslog', 'user',
  147. 'uucp'.  Defaults to 'user'
  148.  
  149. =item * socket ($)
  150.  
  151. Tells what type of socket to use for sending syslog messages.  Valid
  152. options are 'unix' or 'inet'.  Defaults to 'inet'.
  153.  
  154. =item * callbacks( \& or [ \&, \&, ... ] )
  155.  
  156. This parameter may be a single subroutine reference or an array
  157. reference of subroutine references.  These callbacks will be called in
  158. the order they are given and passed a hash containing the following keys:
  159.  
  160.  ( message => $log_message, level => $log_level )
  161.  
  162. The callbacks are expected to modify the message and then return a
  163. single scalar containing that modified message.  These callbacks will
  164. be called when either the C<log> or C<log_to> methods are called and
  165. will only be applied to a given message once.
  166.  
  167. =back
  168.  
  169. =item * log_message( message => $ )
  170.  
  171. Sends a message to the appropriate output.  Generally this shouldn't
  172. be called directly but should be called through the C<log()> method
  173. (in Log::Dispatch::Output).
  174.  
  175. =back
  176.  
  177. =head1 AUTHOR
  178.  
  179. Dave Rolsky, <autarch@urth.org>
  180.  
  181. =cut
  182.