File: Channel.pm

package info (click to toggle)
tiarra 20100212-4
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 2,732 kB
  • ctags: 1,712
  • sloc: perl: 32,032; lisp: 193; sh: 109; makefile: 10
file content (426 lines) | stat: -rw-r--r-- 13,886 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
# -----------------------------------------------------------------------------
# $Id: Channel.pm 36686 2010-02-10 18:47:59Z topia $
# -----------------------------------------------------------------------------
package Log::Channel;
use strict;
use warnings;
use IO::File;
use File::Spec;
use Tiarra::Encoding;
use base qw(Module);
use Module::Use qw(Tools::DateConvert Log::Logger Log::Writer);
use Tools::DateConvert;
use Log::Logger;
use Log::Writer;
use Module::Use qw(Tools::HashTools);
use Tools::HashTools;
use ControlPort;
use Mask;
use Multicast;

our $DEFAULT_FILENAME_ENCODING = $^O eq 'MSWin32' ? 'sjis' : 'utf8';

sub new {
    my $class = shift;
    my $this = $class->SUPER::new(@_);
    $this->{channels} = []; # 要素は[ディレクトリ名,マスク]
    $this->{matching_cache} = {}; # <チャンネル名,ファイル名>
    $this->{writer_cache} = {}; # <チャンネル名,Log::Writer>
    $this->{sync_command} = do {
	my $sync = $this->config->sync;
	if (defined $sync) {
	    uc $sync;
	}
	else {
	    undef;
	}
    };
    $this->{distinguish_myself} = do {
	my $conf_val = $this->config->distinguish_myself;
	if (defined $conf_val) {
	    $conf_val;
	}
	else {
	    1;
	}
    };
    $this->{logger} =
	Log::Logger->new(
	    sub {
		$this->_search_and_write(@_);
	    },
	    $this,
	    'S_PRIVMSG','C_PRIVMSG','S_NOTICE','C_NOTICE');

    $this->_init;
}

sub _init {
    my $this = shift;
    foreach ($this->config->channel('all')) {
	my ($dirname,$mask) = split /\s+/;
	if (!defined($dirname) || $dirname eq '' ||
	    !defined($mask) || $mask eq '') {
	    die 'Illegal definition in '.__PACKAGE__."/channel : $_\n";
	}
	push @{$this->{channels}},[$dirname,$mask];
    }

    $this;
}

sub sync {
    my $this = shift;
    $this->flush_all_file_handles;
    RunLoop->shared->notify_msg("Channel logs synchronized.");
}

sub control_requested {
    my ($this,$request) = @_;
    if ($request->ID eq 'synchronize') {
	$this->sync;
	ControlPort::Reply->new(204,'No Content');
    }
    else {
	die "Log::Channel received control request of unsupported ID ".$request->ID."\n";
    }
}

sub message_arrived {
    my ($this,$message,$sender) = @_;

    # syncは有効で、クライアントから受け取ったメッセージであり、かつ今回のコマンドがsyncに一致しているか?
    if (defined $this->{sync_command} &&
	$sender->isa('IrcIO::Client') &&
	$message->command eq $this->{sync_command}) {
	# 開いているファイルを全てflush。
	# 他のモジュールも同じコマンドでsyncするかも知れないので、
	# do-not-send-to-servers => 1は設定するが
	# メッセージ自体は破棄してしまわない。
	$this->sync;
	$message->remark('do-not-send-to-servers',1);
	return $message;
    }

    # __PACKAGE__/commandにマッチするか?
    if (Mask::match(lc($this->config->command || '*'),lc($message->command))) {
	$this->{logger}->log($message,$sender);
    }

    $message;
}

{
    no warnings qw(once);
    *S_PRIVMSG = \&PRIVMSG_or_NOTICE;
    *S_NOTICE = \&PRIVMSG_or_NOTICE;
    *C_PRIVMSG = \&PRIVMSG_or_NOTICE;
    *C_NOTICE = \&PRIVMSG_or_NOTICE;
}

sub PRIVMSG_or_NOTICE {
    my ($this,$msg,$sender) = @_;
    my $target = Multicast::detatch($msg->param(0));
    my $is_priv = Multicast::nick_p($target);
    my $cmd = $msg->command;

    my $line = do {
	if ($is_priv) {
	    # privの時は自分と相手を必ず区別する。
	    if ($sender->isa('IrcIO::Client')) {
		sprintf(
		    $cmd eq 'PRIVMSG' ? '>%s< %s' : ')%s( %s',
		    $msg->param(0),
		    $msg->param(1));
	    }
	    else {
		sprintf(
		    $cmd eq 'PRIVMSG' ? '-%s- %s' : '=%s= %s',
		    $msg->nick || $sender->current_nick,
		    $msg->param(1));
	    }
	}
	else {
	    my $format = do {
		if ($this->{distinguish_myself} && $sender->isa('IrcIO::Client')) {
		    $cmd eq 'PRIVMSG' ? '>%s:%s< %s' : ')%s:%s( %s';
		}
		else {
		    $cmd eq 'PRIVMSG' ? '<%s:%s> %s' : '(%s:%s) %s';
		}
	    };
	    my $nick = do {
		if ($sender->isa('IrcIO::Client')) {
		    RunLoop->shared_loop->network(
		      (Multicast::detatch($msg->param(0)))[1])
			->current_nick;
		}
		else {
		    $msg->nick || $sender->current_nick;
		}
	    };
	    sprintf $format,$msg->param(0),$nick,$msg->param(1);
	}
    };

    [$is_priv ? 'priv' : $msg->param(0),$line];
}

sub _channel_match {
    # 指定されたチャンネル名にマッチするログ保存ファイルのパターンを定義から探す。
    # 一つもマッチしなければundefを返す。
    # このメソッドは検索結果を$this->{matching_cache}に保存して、後に再利用する。
    my ($this,$channel) = @_;

    my $cached = $this->{matching_cache}->{$channel};
    if (defined $cached) {
	if ($cached eq '') {
	    # マッチするエントリは存在しない、という結果がキャッシュされている。
	    return undef;
	}
	else {
	    return $cached;
	}
    }

    foreach my $ch (@{$this->{channels}}) {
	if (Mask::match($ch->[1],$channel)) {
	    # マッチした。
	    my $fname_format = $this->config->filename || '%Y.%m.%d.txt';
	    # あまり好ましくなさそうな文字はあらかじめエスケープ.
	    my $chan_filename = $channel;
	    $chan_filename =~ s/![0-9A-Z]{5}/!/;
	    $chan_filename =~ s{([^-\w@#%!+&.\x80-\xff])}{
	      sprintf('=%02x', unpack("C", $1));
	    }ge;
	    my $chan_dir = Tools::HashTools::replace_recursive(
		$ch->[0], [{channel => $chan_filename, lc_channel => lc $chan_filename}]);
	    my $fpath_format = "$chan_dir/$fname_format";

	    $this->{matching_cache}->{$channel} = $fpath_format;
	    return $fpath_format;
	}
    }
    $this->{matching_cache}->{$channel} = '';
    undef;
}

sub _search_and_write {
    my ($this,$channel,$line) = @_;
    my $dirname = $this->_channel_match($channel);
    if (defined $dirname) {
	$this->_write($channel,$dirname,$line);
    }
}

sub _write {
    # 指定されたログファイルにヘッダ付きで追記する。
    # ディレクトリ名の日付のマクロは置換される。
    my ($this,$channel,$abstract_fpath,$line) = @_;
    my $concrete_fpath = do {
	my $basedir = $this->config->directory;
	if (defined $basedir) {
	    Tools::DateConvert::replace("$basedir/$abstract_fpath");
	}
	else {
	    Tools::DateConvert::replace($abstract_fpath);
	}
    };
    my $filename_encoding = $this->config->filename_encoding || $DEFAULT_FILENAME_ENCODING;
    if( $filename_encoding ne 'ascii' )
    {
      $concrete_fpath = Tiarra::Encoding->new($concrete_fpath)->conv($filename_encoding);
    }else
    {
      $concrete_fpath =~ s/([^ -~])/sprintf('=%02x', unpack("C", $1))/ge;
    }
    my $header = Tools::DateConvert::replace(
	$this->config->header || '%H:%M'
    );
    my $always_flush = do {
	if ($this->config->keep_file_open) {
	    if ($this->config->always_flush) {
		1;
	    } else {
		0;
	    }
	} else {
	    1;
	}
    };
    # ファイルに追記
    my $make_writer = sub {
	Log::Writer->shared_writer->find_object(
	    $concrete_fpath,
	    always_flush => $always_flush,
	    file_mode_oct => $this->config->mode,
	    dir_mode_oct => $this->config->dir_mode,
	   );
    };
    my $writer = sub {
	# キャッシュは有効か?
	if ($this->config->keep_file_open) {
	    # このチャンネルはキャッシュされているか?
	    my $cached_elem = $this->{writer_cache}->{$channel};
	    if (defined $cached_elem) {
		# キャッシュされたファイルパスは今回のファイルと一致するか?
		if ($cached_elem->uri eq $concrete_fpath) {
		    # このファイルハンドルを再利用して良い。
		    #print "$concrete_fpath: RECYCLED\n";
		    return $cached_elem;
		}
		else {
		    # ファイル名が違う。日付が変わった等の場合。
		    # 古いファイルハンドルを閉じる。
		    #print "$concrete_fpath: recached\n";
		    eval {
			$cached_elem->flush;
			$cached_elem->unregister;
		    };
		    # 新たなファイルハンドルを生成。
		    $cached_elem = $make_writer->();
		    if (defined $cached_elem) {
			$cached_elem->register;
		    }
		    return $cached_elem;
		}
	    }
	    else {
		# キャッシュされていないので、ファイルハンドルを作ってキャッシュ。
		#print "$concrete_fpath: *cached*\n";
		my $cached_elem =
		    $this->{writer_cache}->{$channel} =
			$make_writer->();
		if (defined $cached_elem) {
		    $cached_elem->register;
		}
		return $cached_elem;
	    }
	}
	else {
	    # キャッシュ無効。
	    return $make_writer->();
	}
    }->();
    if (defined $writer) {
	$writer->reserve(
	    Tiarra::Encoding->new("$header $line\n",'utf8')->conv(
		$this->config->charset || 'jis'));
    } else {
	# XXX: do warn with properly frequency
	#RunLoop->shared_loop->notify_warn("can't write to $concrete_fpath: ".
	#				      "$header $line");
    }
}

sub flush_all_file_handles {
    my $this = shift;
    foreach my $cached_elem (values %{$this->{writer_cache}}) {
	eval {
	    $cached_elem->flush;
	};
    }
}

sub destruct {
    my $this = shift;
    # 開いている全てのLog::Writerを閉じて、キャッシュを空にする。
    foreach my $cached_elem (values %{$this->{writer_cache}}) {
	eval {
	    $cached_elem->flush;
	    $cached_elem->unregister;
	};
    }
    %{$this->{writer_cache}} = ();
}

1;

=pod
info: チャンネルやprivのログを取るモジュール。
default: off
section: important

# Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。
# %% : %
# %Y : 年(4桁)
# %m : 月(2桁)
# %d : 日(2桁)
# %H : 時間(2桁)
# %M : 分(2桁)
# %S : 秒(2桁)

# ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。
directory: log

# ログファイルの文字コード。省略されたらjis。
charset: utf8

# 各行のヘッダのフォーマット。省略されたら'%H:%M'。
header: %H:%M:%S

# ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt'
filename: %Y.%m.%d.txt

# ログファイルのモード(8進数)。省略されたら600
mode: 600

# ログディレクトリのモード(8進数)。省略されたら700
dir-mode: 700

# ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。
command: privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice

# PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。
distinguish-myself: 1

# 各ログファイルを開きっぱなしにするかどうか。
# このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが
# ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを
# 別々のファイルにログを取るような場合には使うべきではありません。
# 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・
# 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が
# あります。limit の詳細については OS 等のドキュメントを参照してください。
-keep-file-open: 1

# keep-file-open 時に各行ごとに flush するかどうか。
# open/close の負荷は気になるが、ログは失いたくない人向け。
# keep-file-open が有効でないなら無視され(1になり)ます。
-always-flush: 0

# keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく
# 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても
# 最近の発言はまだ書き込まれていない可能性がある。
# syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。
# 省略された場合はコマンドを追加しない。
sync: sync

# 各チャンネルの設定。チャンネル名の部分はマスクである。
# 個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。
# 記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。
# 指定されたディレクトリが存在しなかったら、Log::Channelはそれを勝手に作る。
# フォーマットは次の通り。
# channel: <ディレクトリ名> (<チャンネル名> / 'priv')
# 例:
# filename: %Y.%m.%d.txt
# channel: IRCDanwasitu #IRC談話室@ircnet
# channel: others *
# この例では、#IRC談話室@ircnetのログはIRCDanwasitu/%Y.%m.%d.txtに、
# それ以外(privも含む)のログはothers/%Y.%m.%d.txtに保存される。
# #(channel) はチャンネル名に展開される。
# (古いバージョンだと展開されずにそのままディレクトリ名になってしまいます。)
# IRCのチャンネル名は大文字小文字が区別されず、サーバからは各送信者が指定した通りの
# チャンネル名が送られてきます。そのため、大文字小文字が区別されるファイルシステムでは
# 同じチャンネルが別々のディレクトリに作られることになります。
# この問題を回避するため、チャンネル名を小文字に統一した #(lc_channel) が利用できます。
channel: priv priv
channel: #(lc_channel) *
-channel: others *

# ファイル名のエンコーディング.
# 指定可能な値は, utf8, sjis, euc, jis, ascii.
# ascii は実際には utf8 と同等で8bit部分が全てquoted-printableされる.
# デフォルトはWindowsではsjis, それ以外では utf8.
-filename-encoding: utf8

=cut