File: Raw.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 (330 lines) | stat: -rw-r--r-- 10,064 bytes parent folder | download | duplicates (4)
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
# -----------------------------------------------------------------------------
# $Id: Raw.pm 11365 2008-05-10 14:58:28Z topia $
# -----------------------------------------------------------------------------
package Log::Raw;
use strict;
use warnings;
use IO::File;
use File::Spec;
use Tiarra::Encoding;
use base qw(Module);
use Module::Use qw(Tools::DateConvert Log::Writer);
use Tools::DateConvert;
use Log::Writer;
use ControlPort;
use Mask;

sub new {
    my $class = shift;
    my $this = $class->SUPER::new(@_);
    $this->{matching_cache} = {}; # <servername,fname>
    $this->{writer_cache} = {}; # <server,Log::Writer>
    $this->{sync_command} = do {
	my $sync = $this->config->sync;
	if (defined $sync) {
	    uc $sync;
	}
	else {
	    undef;
	}
    };
    $this;
}

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

sub control_requested {
    my ($this,$request) = @_;
    if ($request->ID eq 'synchronize') {
	$this->sync;
	ControlPort::Reply->new(204,'No Content');
    }
    else {
	die ref($this)." 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;
    }
    $message;
}

sub message_io_hook {
    my ($this,$message,$io,$type) = @_;

    # break with last
    while (1) {
	last unless $io->server_p;
	last unless Mask::match_deep([Mask::array_or_all(
	    $this->config->command('all'))], $message->command);
	my $msg = $message->clone;
	if ($this->config->resolve_numeric && $message->command =~ /^\d{3}$/) {
	    $msg->command(
		(NumericReply::fetch_name($message->command)||'undef').
		    '('.$message->command.')');
	}
	my $server = $io->network_name;
	my $dirname = $this->_server_match($server);
	if (defined $dirname) {
	    my $prefix  = sprintf '(%s/%s) ', $server, do {
		if ($type eq 'in') {
		    'recv';
		} elsif ($type eq 'out') {
		    'send';
		} else {
		    '----';
		}
	    };

	    my $charset = do {
		if ($msg->have_raw_params) {
		    $msg->encoding_params('binary');
		    'binary';
		} elsif ($io->can('out_encoding')) {
		    $io->out_encoding;
		} else {
		    $this->config->charset;
		}
	    };
	    $this->_write($server, $dirname, $msg->time, $prefix .
			      $msg->serialize($charset));
	}
	last;
    }

    return $message;
}

sub _server_match {
    my ($this,$server) = @_;

    my $cached = $this->{matching_cache}->{$server};
    if (defined $cached) {
	if ($cached eq '') {
	    # cache of not found
	    return undef;
	}
	else {
	    return $cached;
	}
    }

    foreach my $line ($this->config->server('all')) {
	my ($name, $mask) = split /\s+/, $line, 2;
	if (Mask::match($mask,$server)) {
	    # マッチした。
	    my $fname_format = $this->config->filename || '%Y.%m.%d.txt';
	    my $fpath_format = $name."/$fname_format";

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

sub _write {
    # 指定されたログファイルにヘッダ付きで追記する。
    # ディレクトリ名の日付のマクロは置換される。
    my ($this,$channel,$abstract_fpath,$time,$line) = @_;
    my $concrete_fpath = do {
	my $basedir = $this->config->directory;
	if (defined $basedir) {
	    Tools::DateConvert::replace("$basedir/$abstract_fpath", $time);
	}
	else {
	    Tools::DateConvert::replace($abstract_fpath, $time);
	}
    };
    my $header = Tools::DateConvert::replace(
	$this->config->header || '%H:%M',
	$time,
       );
    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("$header $line\n");
    } 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: サーバとの生の通信を保存する
default: off

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

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

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

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

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

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

# 使っている文字コードがよくわからなかったときの文字コード。省略されたらutf8。
# たぶんこの指定が生きることはないと思いますが……。
charset: jis

# NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります)
resolve-numeric: 1

# ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。
command: *,-ping,-pong

# 各ログファイルを開きっぱなしにするかどうか。
# このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが
# ログを記録すべき全てのファイルを開いたままにするので、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

# 各サーバの設定。サーバ名の部分はマスクである。
# 記述された順序で検索されるので、全てのサーバにマッチする"*"などは最後に書かなければならない。
# 指定されたディレクトリが存在しなかったら、勝手に作られる。
# フォーマットは次の通り。
# channel: <ディレクトリ名> <サーバ名マスク>
# 例:
# filename: %Y-%m-%d.txt
# server: ircnet ircnet
# server: others *
# この例では、ircnetのログはircnet/%Y.%m.%d.txtに、
# それ以外のログはothers/%Y.%m.%d.txtに保存される。
server: ircnet ircnet
server: others *
=cut