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