root/dan/perl/tiarra/trunk/module/Log/Channel.pm @ 5905

Revision 3004, 10.3 kB (checked in by topia, 6 years ago)

lang/perl/tiarra: import.

  • Property svn:mime-type set to text/x-perl; charset=EUC-JP
  • Property svn:eol-style set to LF
  • Property svn:keywords set to Id URL Date Rev Author
Line 
1# -----------------------------------------------------------------------------
2# $Id$
3# -----------------------------------------------------------------------------
4package Log::Channel;
5use strict;
6use warnings;
7use IO::File;
8use File::Spec;
9use Tiarra::Encoding;
10use base qw(Module);
11use Module::Use qw(Tools::DateConvert Log::Logger Log::Writer);
12use Tools::DateConvert;
13use Log::Logger;
14use Log::Writer;
15use ControlPort;
16use Mask;
17use Multicast;
18
19sub new {
20    my $class = shift;
21    my $this = $class->SUPER::new(@_);
22    $this->{channels} = []; # 要素は[ディレクトリ名,マスク]
23    $this->{matching_cache} = {}; # <チャンネル名,ファイル名>
24    $this->{writer_cache} = {}; # <チャンネル名,Log::Writer>
25    $this->{sync_command} = do {
26        my $sync = $this->config->sync;
27        if (defined $sync) {
28            uc $sync;
29        }
30        else {
31            undef;
32        }
33    };
34    $this->{distinguish_myself} = do {
35        my $conf_val = $this->config->distinguish_myself;
36        if (defined $conf_val) {
37            $conf_val;
38        }
39        else {
40            1;
41        }
42    };
43    $this->{logger} =
44        Log::Logger->new(
45            sub {
46                $this->_search_and_write(@_);
47            },
48            $this,
49            'S_PRIVMSG','C_PRIVMSG','S_NOTICE','C_NOTICE');
50
51    $this->_init;
52}
53
54sub _init {
55    my $this = shift;
56    foreach ($this->config->channel('all')) {
57        my ($dirname,$mask) = split /\s+/;
58        if (!defined($dirname) || $dirname eq '' ||
59            !defined($mask) || $mask eq '') {
60            die 'Illegal definition in '.__PACKAGE__."/channel : $_\n";
61        }
62        push @{$this->{channels}},[$dirname,$mask];
63    }
64
65    $this;
66}
67
68sub sync {
69    my $this = shift;
70    $this->flush_all_file_handles;
71    RunLoop->shared->notify_msg("Channel logs synchronized.");
72}
73
74sub control_requested {
75    my ($this,$request) = @_;
76    if ($request->ID eq 'synchronize') {
77        $this->sync;
78        ControlPort::Reply->new(204,'No Content');
79    }
80    else {
81        die "Log::Channel received control request of unsupported ID ".$request->ID."\n";
82    }
83}
84
85sub message_arrived {
86    my ($this,$message,$sender) = @_;
87
88    # syncは有効で、クライアントから受け取ったメッセージであり、かつ今回のコマンドがsyncに一致しているか?
89    if (defined $this->{sync_command} &&
90        $sender->isa('IrcIO::Client') &&
91        $message->command eq $this->{sync_command}) {
92        # 開いているファイルを全てflush。
93        # 他のモジュールも同じコマンドでsyncするかも知れないので、
94        # do-not-send-to-servers => 1は設定するが
95        # メッセージ自体は破棄してしまわない。
96        $this->sync;
97        $message->remark('do-not-send-to-servers',1);
98        return $message;
99    }
100
101    # __PACKAGE__/commandにマッチするか?
102    if (Mask::match(lc($this->config->command || '*'),lc($message->command))) {
103        $this->{logger}->log($message,$sender);
104    }
105
106    $message;
107}
108
109*S_PRIVMSG = \&PRIVMSG_or_NOTICE;
110*S_NOTICE = \&PRIVMSG_or_NOTICE;
111*C_PRIVMSG = \&PRIVMSG_or_NOTICE;
112*C_NOTICE = \&PRIVMSG_or_NOTICE;
113sub PRIVMSG_or_NOTICE {
114    my ($this,$msg,$sender) = @_;
115    my $target = Multicast::detatch($msg->param(0));
116    my $is_priv = Multicast::nick_p($target);
117    my $cmd = $msg->command;
118
119    my $line = do {
120        if ($is_priv) {
121            # privの時は自分と相手を必ず区別する。
122            if ($sender->isa('IrcIO::Client')) {
123                sprintf(
124                    $cmd eq 'PRIVMSG' ? '>%s< %s' : ')%s( %s',
125                    $msg->param(0),
126                    $msg->param(1));
127            }
128            else {
129                sprintf(
130                    $cmd eq 'PRIVMSG' ? '-%s- %s' : '=%s= %s',
131                    $msg->nick || $sender->current_nick,
132                    $msg->param(1));
133            }
134        }
135        else {
136            my $format = do {
137                if ($this->{distinguish_myself} && $sender->isa('IrcIO::Client')) {
138                    $cmd eq 'PRIVMSG' ? '>%s:%s< %s' : ')%s:%s( %s';
139                }
140                else {
141                    $cmd eq 'PRIVMSG' ? '<%s:%s> %s' : '(%s:%s) %s';
142                }
143            };
144            my $nick = do {
145                if ($sender->isa('IrcIO::Client')) {
146                    RunLoop->shared_loop->network(
147                      (Multicast::detatch($msg->param(0)))[1])
148                        ->current_nick;
149                }
150                else {
151                    $msg->nick || $sender->current_nick;
152                }
153            };
154            sprintf $format,$msg->param(0),$nick,$msg->param(1);
155        }
156    };
157
158    [$is_priv ? 'priv' : $msg->param(0),$line];
159}
160
161sub _channel_match {
162    # 指定されたチャンネル名にマッチするログ保存ファイルのパターンを定義から探す。
163    # 一つもマッチしなければundefを返す。
164    # このメソッドは検索結果を$this->{matching_cache}に保存して、後に再利用する。
165    my ($this,$channel) = @_;
166
167    my $cached = $this->{matching_cache}->{$channel};
168    if (defined $cached) {
169        if ($cached eq '') {
170            # マッチするエントリは存在しない、という結果がキャッシュされている。
171            return undef;
172        }
173        else {
174            return $cached;
175        }
176    }
177
178    foreach my $ch (@{$this->{channels}}) {
179        if (Mask::match($ch->[1],$channel)) {
180            # マッチした。
181            my $fname_format = $this->config->filename || '%Y.%m.%d.txt';
182            my $fpath_format = $ch->[0]."/$fname_format";
183
184            $this->{matching_cache}->{$channel} = $fpath_format;
185            return $fpath_format;
186        }
187    }
188    $this->{matching_cache}->{$channel} = '';
189    undef;
190}
191
192sub _search_and_write {
193    my ($this,$channel,$line) = @_;
194    my $dirname = $this->_channel_match($channel);
195    if (defined $dirname) {
196        $this->_write($channel,$dirname,$line);
197    }
198}
199
200sub _write {
201    # 指定されたログファイルにヘッダ付きで追記する。
202    # ディレクトリ名の日付のマクロは置換される。
203    my ($this,$channel,$abstract_fpath,$line) = @_;
204    my $concrete_fpath = do {
205        my $basedir = $this->config->directory;
206        if (defined $basedir) {
207            Tools::DateConvert::replace("$basedir/$abstract_fpath");
208        }
209        else {
210            Tools::DateConvert::replace($abstract_fpath);
211        }
212    };
213    my $header = Tools::DateConvert::replace(
214        $this->config->header || '%H:%M'
215    );
216    my $always_flush = do {
217        if ($this->config->keep_file_open) {
218            if ($this->config->always_flush) {
219                1;
220            } else {
221                0;
222            }
223        } else {
224            1;
225        }
226    };
227    # ファイルに追記
228    my $make_writer = sub {
229        Log::Writer->shared_writer->find_object(
230            $concrete_fpath,
231            always_flush => $always_flush,
232            file_mode_oct => $this->config->mode,
233            dir_mode_oct => $this->config->dir_mode,
234           );
235    };
236    my $writer = sub {
237        # キャッシュは有効か?
238        if ($this->config->keep_file_open) {
239            # このチャンネルはキャッシュされているか?
240            my $cached_elem = $this->{writer_cache}->{$channel};
241            if (defined $cached_elem) {
242                # キャッシュされたファイルパスは今回のファイルと一致するか?
243                if ($cached_elem->uri eq $concrete_fpath) {
244                    # このファイルハンドルを再利用して良い。
245                    #print "$concrete_fpath: RECYCLED\n";
246                    return $cached_elem;
247                }
248                else {
249                    # ファイル名が違う。日付が変わった等の場合。
250                    # 古いファイルハンドルを閉じる。
251                    #print "$concrete_fpath: recached\n";
252                    eval {
253                        $cached_elem->flush;
254                        $cached_elem->unregister;
255                    };
256                    # 新たなファイルハンドルを生成。
257                    $cached_elem = $make_writer->();
258                    if (defined $cached_elem) {
259                        $cached_elem->register;
260                    }
261                    return $cached_elem;
262                }
263            }
264            else {
265                # キャッシュされていないので、ファイルハンドルを作ってキャッシュ。
266                #print "$concrete_fpath: *cached*\n";
267                my $cached_elem =
268                    $this->{writer_cache}->{$channel} =
269                        $make_writer->();
270                if (defined $cached_elem) {
271                    $cached_elem->register;
272                }
273                return $cached_elem;
274            }
275        }
276        else {
277            # キャッシュ無効。
278            return $make_writer->();
279        }
280    }->();
281    if (defined $writer) {
282        $writer->reserve(
283            Tiarra::Encoding->new("$header $line\n",'utf8')->conv(
284                $this->config->charset || 'jis'));
285    } else {
286        # XXX: do warn with properly frequency
287        #RunLoop->shared_loop->notify_warn("can't write to $concrete_fpath: ".
288        #                                     "$header $line");
289    }
290}
291
292sub flush_all_file_handles {
293    my $this = shift;
294    foreach my $cached_elem (values %{$this->{writer_cache}}) {
295        eval {
296            $cached_elem->flush;
297        };
298    }
299}
300
301sub destruct {
302    my $this = shift;
303    # 開いている全てのLog::Writerを閉じて、キャッシュを空にする。
304    foreach my $cached_elem (values %{$this->{writer_cache}}) {
305        eval {
306            $cached_elem->flush;
307            $cached_elem->unregister;
308        };
309    }
310    %{$this->{writer_cache}} = ();
311}
312
3131;
314
315=pod
316info: チャンネルやprivのログを取るモジュール。
317default: off
318section: important
319
320# Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。
321# %% : %
322# %Y : 年(4桁)
323# %m : 月(2桁)
324# %d : 日(2桁)
325# %H : 時間(2桁)
326# %M : 分(2桁)
327# %S : 秒(2桁)
328
329# ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。
330directory: log
331
332# ログファイルの文字コード。省略されたらjis。
333charset: sjis
334
335# 各行のヘッダのフォーマット。省略されたら'%H:%M'。
336header: %H:%M:%S
337
338# ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt'
339filename: %Y.%m.%d.txt
340
341# ログファイルのモード(8進数)。省略されたら600
342mode: 600
343
344# ログディレクトリのモード(8進数)。省略されたら700
345dir-mode: 700
346
347# ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。
348command: privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice
349
350# PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。
351distinguish-myself: 1
352
353# 各ログファイルを開きっぱなしにするかどうか。
354# このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが
355# ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを
356# 別々のファイルにログを取るような場合には使うべきではありません。
357# 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・
358# 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が
359# あります。limit の詳細については OS 等のドキュメントを参照してください。
360-keep-file-open: 1
361
362# keep-file-open 時に各行ごとに flush するかどうか。
363# open/close の負荷は気になるが、ログは失いたくない人向け。
364# keep-file-open が有効でないなら無視され(1になり)ます。
365-always-flush: 0
366
367# keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく
368# 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても
369# 最近の発言はまだ書き込まれていない可能性がある。
370# syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。
371# 省略された場合はコマンドを追加しない。
372sync: sync
373
374# 各チャンネルの設定。チャンネル名の部分はマスクである。
375# 個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。
376# 記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。
377# 指定されたディレクトリが存在しなかったら、Log::Channelはそれを勝手に作る。
378# フォーマットは次の通り。
379# channel: <ディレクトリ名> (<チャンネル名> / 'priv')
380# 例:
381# filename: %Y.%m.%d.txt
382# channel: IRCDanwasitu #IRC談話室@ircnet
383# channel: others *
384# この例では、#IRC談話室@ircnetのログはIRCDanwasitu/%Y.%m.%d.txtに、
385# それ以外(privも含む)のログはothers/%Y.%m.%d.txtに保存される。
386channel: priv priv
387channel: others *
388=cut
Note: See TracBrowser for help on using the browser.