lib/Keitairc/Log.pm

   1 # -*- mode: perl; coding: utf-8 -*-
   2 # Keitairc::Log
   3 #
   4 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
   5 # Copyright (c) 2010 ISHIKAWA Mutsumi <ishikawa@hanzubon.jp>
   6 # This program is covered by the GNU General Public License 2
   7
   8 package Keitairc::Log;
   9 use Keitairc::Config;
  10 use POSIX qw(strftime locale_h);
  11 use strict;
  12 use warnings;
  13
  14 sub new {
  15         my ($proto, $arg) = @_;
  16         my $me = {};
  17
  18         bless $me;
  19
  20         if (defined $arg->{config}) {
  21                 $me->config($arg->{config});
  22         } else {
  23                 require Keitairc::Log::Stdio;
  24                 $me->{writer} = new Keitairc::Log::Stdio();
  25         }
  26
  27         return $me;
  28 }
  29
  30 sub config {
  31         my ($me, $cf) = @_;
  32         $me->{Config} = $cf;
  33         ($me->{type}, undef) = split(':', $me->{Config}->log(), 2);
  34
  35         my $fallback = 0;
  36         if ($me->{type} =~ /^syslog$/i) {
  37                 if (eval "use Sys::Syslog") {
  38                         require Keitairc::Log::Syslog;
  39                         $me->{writer} = new Keitairc::Log::Syslog({config => $me->{Config}});
  40                 } else {
  41                         # force fallback to file writer
  42                         $me->{type} = 'file';
  43                         $fallback = 1;
  44                 }
  45         }
  46
  47         if ($me->{type} =~ /^file$/i ) {
  48                 require Keitairc::Log::File;
  49                 $me->{writer} = new Keitairc::Log::File({config => $me->{Config}});
  50         } else {
  51                 require Keitairc::Log::Stdio;
  52                 $me->{writer} = new Keitairc::Log::Stdio({config => $me->{Config}}) if (!defined $me->{writer} || !$me->{writer});
  53         }
  54         if ($fallback) {
  55                 $me->log_error('Sys::Syslog is missing, fallback to file log writer');
  56         }
  57 }
  58
  59 sub log_access {
  60         my ($me, $ip, $request, $response) = @_;
  61         my $old_locate = setlocale(LC_TIME);
  62         setlocale(LC_TIME, 'POSIX');
  63         $me->{writer}->log_access(sprintf('%s %s %s [%s] "%s" %s %s "%s" "%s"',
  64                                           $ip || '-',
  65                                           '-',
  66                                           $request->header('Remote-User') || '-',
  67                                           strftime('%d/%b/%Y:%T %z', localtime()),
  68                                           $request->method() . ' ' . $request->uri() || '-',
  69                                           $response->code,
  70                                           length($response->content),
  71                                           $request->header('referer') || '-',
  72                                           $request->header('User-Agent') || '-'));
  73         setlocale(LC_TIME, $old_locate);
  74 }
  75
  76 sub _format {
  77         my ($me, $m) = @_;
  78         if (!defined $me->{type} || $me->{type} !~ /^syslog$/i) {
  79                 my $old_locate = setlocale(LC_TIME);
  80                 setlocale(LC_TIME, 'POSIX');
  81                 $m = strftime('%b %d %T ', localtime()) . $m;
  82                 setlocale(LC_TIME, $old_locate);
  83         }
  84         return $m;
  85 }
  86
  87 sub log {
  88         my ($me, $m) = @_;
  89         $me->{writer}->log_info($me->_format($m));
  90 }
  91
  92 sub log_error {
  93         my ($me, $m) = @_;
  94         $me->{writer}->log_error($me->_format($m));
  95 }
  96
  97 sub log_debug {
  98         my ($me, $m) = @_;
  99         $me->{writer}->log_debug($me->_format($m));
 100 }
 101
 102 sub log_die {
 103         my ($me, $m) = @_;
 104         $me->log_error($m);
 105         die;
 106 }
 107
 108 1;