1# -----------------------------------------------------------------------------
2# $Id: IrcIO.pm 11365 2008-05-10 14:58:28Z topia $
3# -----------------------------------------------------------------------------
4# IrcIOはIRCサーバー又はクライアントと接続し、IRCメッセージをやり取りする抽象クラスです。
5# -----------------------------------------------------------------------------
6package IrcIO;
7use strict;
8use warnings;
9use Carp;
10use Configuration;
11use Tiarra::IRC::Message;
12use Exception;
13use Tiarra::ShorthandConfMixin;
14use Tiarra::Utils;
15use Tiarra::Socket::Buffered;
16use base qw(Tiarra::Socket::Buffered);
17use base qw(Tiarra::IRC::NewMessageMixin);
18utils->define_attr_getter(0, [qw(_runloop runloop)]);
19utils->define_proxy('_runloop', 0, qw(irc_message_class));
20
21sub new {
22    my ($class, $runloop, %opts) = @_;
23    carp 'runloop is not specified!' unless defined $runloop;
24    $class->_increment_caller('ircio', \%opts);
25    my $this = $class->SUPER::new(runloop => $runloop, %opts);
26    $this->{recv_queue} = [];
27    $this->{remarks} = {};
28    $this;
29}
30
31sub server_p {
32    shift->isa('IrcIO::Server');
33}
34
35sub client_p {
36    shift->isa('IrcIO::Client');
37}
38
39*remarks = \&remark;
40sub remark {
41    my ($this,$key,$newvalue) = @_;
42    if (!defined $key) {
43	croak "IrcIO->remark, Arg[1] is undef.\n";
44    }
45    elsif (defined $newvalue) {
46	$this->{remarks}->{$key} = $newvalue;
47    }
48    elsif (@_ >= 3) {
49	delete $this->{remarks}{$key};
50    }
51    $this->{remarks}->{$key};
52}
53
54sub send_message {
55    my ($this,$msg,$encoding) = @_;
56    # データを送るように予約する。ソケットの送信の準備が整っていなくてもブロックしない。
57
58    # msgは生の文字列でも良いしTiarra::IRC::Messageのインスタンスでも良い。
59    # 生の文字列を渡す時には、末尾にCRLFを付けてはならない。
60    # また、生の文字列については文字コードの変換が行なわれない。
61    my $data_to_send = '';
62    if (ref($msg) eq '') {
63	# deprecated.
64	# FIXME: warnすべきだろうか。
65	$data_to_send = "$msg\x0d\x0a";
66    }
67    elsif ($msg->isa($this->irc_message_class)) {
68	# message_io_hook
69	my $filtered = $this->_runloop->apply_filters(
70	    [$msg], 'message_io_hook', $this, 'out');
71
72	# message_encoding_hook
73	$filtered = $this->_runloop->apply_filters(
74	    $filtered, 'message_encoding_hook', $this, 'out', $encoding);
75
76	foreach (@$filtered) {
77	    $data_to_send .= $_->serialize("remark,$encoding")."\x0d\x0a";
78	}
79
80    }
81    else {
82	die "IrcIO::send_message : parameter msg was invalid; $msg\n";
83    }
84
85    if ($this->connected) {
86	$this->append($data_to_send);
87    }
88    else {
89	die "IrcIO::send_message : socket is not connected.\n";
90    }
91}
92
93sub read {
94    my ($this,$encoding) = @_;
95    # このメソッドはIRCメッセージを一行ずつ受け取り、Tiarra::IRC::Messageのインスタンスをキューに溜めます。
96    # ソケットに読めるデータが来ていなかった場合、このメソッドは読めるようになるまで
97    # 操作をブロックします。それがまずい場合は予めselectで読める事を確認しておいて下さい。
98    # このメソッドを実行したことで始めてソケットが閉じられた事が分かった場合は、
99    # メソッド実行後からはconnectedメソッドが偽を返すようになります。
100
101    $this->SUPER::read;
102
103    while (1) {
104	# CRLFまたはLFが行の終わり。
105	my $newline_pos = index($this->recvbuf,"\x0a");
106	if ($newline_pos == -1) {
107	    # 一行分のデータが届いていない。
108	    last;
109	}
110
111	my $current_line = substr($this->recvbuf,0,$newline_pos);
112	$this->recvbuf(substr($this->recvbuf,$newline_pos+1));
113
114	# CRLFだった場合、末尾にCRが付いているので取る。
115	$current_line =~ s/\x0d$//;
116
117	if (CORE::length($current_line) == 0) {
118	    # 空行はスキップ
119	    next;
120	}
121
122	my $msg = $this->construct_irc_message(
123	    Line => $current_line,
124	    Encoding => $encoding);
125
126	# message_encoding_hook
127	my $filtered = $this->_runloop->apply_filters(
128	    [$msg], 'message_encoding_hook', $this, 'in', $encoding);
129
130	# message_io_hook
131	$filtered = $this->_runloop->apply_filters(
132	    $filtered, 'message_io_hook', $this, 'in');
133
134	foreach (@$filtered) {
135	    $_->purge_raw_params;
136	    push @{$this->{recv_queue}}, $_;
137	}
138    }
139}
140
141sub pop_queue {
142    # このメソッドは受信キュー内の最も古いものを取り出します。
143    # キューが空ならQueueIsEmptyExceptionを投げます。
144    my ($this) = @_;
145    if (@{$this->{recv_queue}} == 0) {
146	QueueIsEmptyException->new->throw;
147    }
148    else {
149	return shift @{$this->{recv_queue}};
150    }
151}
152
1531;
154