lib/Keitairc/IrcBuffer.pm

   1 # -*- mode: perl; coding: utf-8 -*-
   2 # Keitairc::IrcBuffer
   3 #
   4 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
   5 # This program is covered by the GNU General Public License 2
   6
   7 package Keitairc::IrcBuffer;
   8 use strict;
   9 use warnings;
  10
  11 ################################################################
  12 sub new{
  13         my $proto = shift;
  14         my $arg = shift;
  15         my $me = {};
  16
  17         $me->{history} = $arg->{history};
  18
  19         # join しているchannelの名称を記録するハッシュ。
  20         # - cid および name2cid ハッシュに格納されている値は整数。
  21         # - cid2nameハッシュに格納されているのは perl decoded な チャネル名
  22         $me->{cid2name} = {};
  23         $me->{name2cid} = {};
  24
  25         # join しているtopicの名称を記録するハッシュ
  26         # charset: perl internal
  27         $me->{topic} = {};
  28
  29         $me->{nicks} = {};
  30
  31         $me->{tbuffer} = {};    # time, ref to array
  32         $me->{nbuffer} = {};    # nick, ref to array
  33         $me->{mbuffer} = {};    # message, perl internal, ref to array
  34         $me->{rbuffer} = {};    # read flag, ref to array
  35
  36         # 各チャネルの最終発言時刻
  37         $me->{mtime} = {};
  38
  39         # timestamp of last posted message
  40         $me->{timestamp} = 0;
  41
  42         bless $me;
  43 }
  44
  45 ################################################################
  46 sub add_nick{
  47         my($me, $cid, $nick, $chop, $realname) = @_;
  48         $me->{nicks}->{$cid}->{$nick}->{realname} = $realname;
  49         $me->{nicks}->{$cid}->{$nick}->{chop} = $chop;
  50 }
  51
  52 ################################################################
  53 sub list_nick{
  54         my($me, $cid, $nick, $chop, $realname) = @_;
  55         keys %{$me->{nicks}->{$cid}};
  56 }
  57
  58 ################################################################
  59 sub remove_nick{
  60         my($me, $cid, $nick) = @_;
  61         delete $me->{nicks}->{$cid}->{$nick};
  62 }
  63
  64 ################################################################
  65 sub get_nick_realname{
  66         my($me, $cid, $nick) = @_;
  67         $me->{nicks}->{$cid}->{$nick}->{realname};
  68 }
  69
  70 ################################################################
  71 sub op_nick{
  72         my($me, $cid, $nick) = @_;
  73         if(defined $me->{nicks}->{$cid}){
  74                 if(defined $me->{nicks}->{$cid}->{$nick}){
  75                         $me->{nicks}->{$cid}->{$nick}->{chop} = 1;
  76                 }
  77         }
  78 }
  79
  80 ################################################################
  81 sub deop_nick{
  82         my($me, $cid, $nick) = @_;
  83         if(defined $me->{nicks}->{$cid}){
  84                 if(defined $me->{nicks}->{$cid}->{$nick}){
  85                         $me->{nicks}->{$cid}->{$nick}->{chop} = 0;
  86                 }
  87         }
  88 }
  89
  90 ################################################################
  91 sub get_nick_op{
  92         my($me, $cid, $nick) = @_;
  93         if(defined $me->{nicks}->{$cid}){
  94                 if(defined $me->{nicks}->{$cid}->{$nick}){
  95                         return $me->{nicks}->{$cid}->{$nick}->{chop};
  96                 }
  97         }
  98 }
  99
 100 ################################################################
 101 sub channels{
 102         my $me = shift;
 103         map {
 104                 $_
 105         }(sort
 106           {
 107                   $me->mtime($b) <=> $me->mtime($a)
 108           } keys %{$me->{cid2name}});
 109 }
 110
 111 ################################################################
 112 sub format_time{
 113         my ($me, $t) = @_;
 114         my ($sec, $min, $hour) = localtime($t);
 115         sprintf('%02d:%02d', $hour, $min);
 116 }
 117
 118 ################################################################
 119 sub format_date{
 120         my ($me, $t) = @_;
 121         my ($sec, $min, $hour, $day, $month, $year) = localtime($t);
 122         sprintf('%04d/%02d/%02d', $year+1900, $month+1, $day);
 123 }
 124
 125 ################################################################
 126 sub name2cid{
 127         my($me, $name) = @_;
 128         my $raw_name = $name;
 129         $name =~ tr/A-Z[\\]^/a-z{|}~/;
 130
 131         unless(defined $me->{name2cid}->{$name}){
 132                 my $cid = (sort { $b - $a } (keys %{$me->{cid2name}}))[0];
 133                 $cid++;
 134                 $me->{cid2name}->{$cid} = $raw_name;
 135                 $me->{name2cid}->{$name} = $cid;
 136         }
 137
 138         $me->{name2cid}->{$name};
 139 }
 140
 141 ################################################################
 142 sub cid2name{
 143         my($me, $cid) = @_;
 144         $me->{cid2name}->{$cid};
 145 }
 146
 147 ################################################################
 148 sub part{
 149         my($me, $cid) = @_;
 150         delete $me->{cid2name}->{$cid};
 151         delete $me->{name2cid}->{$cid};
 152         delete $me->{topic}->{$cid};
 153         delete $me->{nicks}->{$cid};
 154         delete $me->{tbuffer}->{$cid};
 155         delete $me->{nbuffer}->{$cid};
 156         delete $me->{mbuffer}->{$cid};
 157         delete $me->{rbuffer}->{$cid};
 158 }
 159
 160 ################################################################
 161 sub join{
 162         my ($me, $name) = @_;
 163         my $cid = $me->name2cid($name);
 164 }
 165
 166 ################################################################
 167 sub mtime{
 168         my($me, $cid) = @_;
 169         $me->{mtime}->{$cid} || 0;
 170 }
 171
 172 ################################################################
 173 sub unread_lines{
 174         my($me, $cid) = @_;
 175         scalar grep(/0/, @{$me->{rbuffer}->{$cid}});
 176 }
 177
 178 ################################################################
 179 sub topic{
 180         my($me, $cid, $topic) = @_;
 181         if(defined $topic){
 182                 $me->{topic}->{$cid} = $topic;
 183         }
 184         $me->{topic}->{$cid};
 185 }
 186
 187 ################################################################
 188 sub buffer_ptr{
 189         my($me, $cid) = @_;
 190         ($me->{tbuffer}->{$cid}, $me->{nbuffer}->{$cid},
 191          $me->{mbuffer}->{$cid}, $me->{rbuffer}->{$cid});
 192 }
 193
 194 ################################################################
 195 # 引数の $msg の charset は perl internal
 196 sub add_message{
 197         my($me, $cid, $message, $who) = @_;
 198
 199         unless(defined $me->{tbuffer}->{$cid}){
 200                 $me->{tbuffer}->{$cid} = [];
 201         }
 202         unless(defined $me->{nbuffer}->{$cid}){
 203                 $me->{nbuffer}->{$cid} = [];
 204                 }
 205         unless(defined $me->{mbuffer}->{$cid}){
 206                 $me->{mbuffer}->{$cid} = [];
 207         }
 208         unless(defined $me->{rbuffer}->{$cid}){
 209                 $me->{rbuffer}->{$cid} = [];
 210         }
 211
 212         push @{$me->{tbuffer}->{$cid}}, time;
 213         push @{$me->{nbuffer}->{$cid}}, $who;
 214         push @{$me->{mbuffer}->{$cid}}, $message;
 215         push @{$me->{rbuffer}->{$cid}}, 0;
 216
 217         if(@{$me->{tbuffer}->{$cid}} > $me->{history}){
 218                 shift @{$me->{tbuffer}->{$cid}};
 219         }
 220         if(@{$me->{nbuffer}->{$cid}} > $me->{history}){
 221                 shift @{$me->{nbuffer}->{$cid}};
 222         }
 223         if(@{$me->{mbuffer}->{$cid}} > $me->{history}){
 224                 shift @{$me->{mbuffer}->{$cid}};
 225         }
 226         if(@{$me->{rbuffer}->{$cid}} > $me->{history}){
 227                 shift @{$me->{rbuffer}->{$cid}};
 228         }
 229
 230         if($me->{cid2name}->{$cid} eq '*console*') {
 231                 $me->{mtime}->{$cid} = -1;
 232         } else {
 233                 $me->{mtime}->{$cid} = time;
 234         }
 235 }
 236
 237 ################################################################
 238 # チャネル名称を短かくする
 239 # 返り値は Perl internal code
 240 sub compact_channel_name{
 241         my $me = shift;
 242         my $cid = shift;
 243         my $name = $me->cid2name($cid);
 244
 245         return undef unless defined $name;
 246
 247         # #name:*.jp を %name に
 248         if($name =~ s/:\*\.jp$//){
 249                 $name =~ s/^#/%/;
 250         }
 251
 252         # 末尾の単独の @ は取る (plumプラグインのmulticast.plm対策)
 253         # @ の後に空白が入ることもあるようだ。理由はわからない。
 254         $name =~ s/\@\s*$//;
 255         $name;
 256 }
 257
 258 ################################################################
 259 sub simple_escape{
 260         my $me = shift;
 261         local($_) = shift;
 262         if(defined $_){
 263                 s/&/&amp;/g;
 264                 s/>/&gt;/g;
 265                 s/</&lt;/g;
 266                 s/{/&#123;/g;
 267                 s/}/&#125;/g;
 268                 s/\+/&#043;/g;
 269         }
 270         $_;
 271 }
 272
 273 ################################################################
 274 sub colorize{
 275         my $me = shift;
 276         local($_) = shift;
 277
 278         my %ct = (
 279                 1 => 'Black',
 280                 2 => '#000080', # Navy Blue
 281                 3 => 'Green',
 282                 4 => 'Red',
 283                 5 => 'Maroon',
 284                 6 => 'Purple',
 285                 7 => 'Olive',
 286                 8 => 'Yellow',
 287                 9 => '#32cd32', # Lime Green
 288                 10 => 'Teal',
 289                 11 => 'Aqua',
 290                 12 => '#4169e1', # Royal Blue
 291                 13 => '#ff69b4', # Hot Pink
 292                 14 => '#a9a9a9', # Dark Gray
 293                 15 => '#d3d3d3', # Light Gray
 294                 16 => 'White');
 295         my $colored = 0;
 296
 297         return undef unless defined $_;
 298
 299         do{
 300                 if($colored){
 301                         s|\x03(\d{1,2})|sprintf('</font><font color="%s">', $ct{0+$1})|e;
 302                         if(s|\x03|</font>|){
 303                                 $colored = 0;
 304                         }
 305                 }else{
 306                         if(s|\x03(\d{1,2})|sprintf('<font color="%s">', $ct{0+$1})|e){
 307                                 $colored = 1;
 308                         }
 309                 }
 310         }while(m|\x03\d{1,2}|);
 311
 312         if($colored){
 313                 $_ .= '</font>';
 314         }
 315
 316         $_;
 317 }
 318
 319 ################################################################
 320 # 同一秒間の連続発言を防ぐためのチェック。
 321 #
 322 # 前回 update_timestamp() が呼ばれた時刻と同じ時刻に
 323 # 再度 update_timestamp() が呼ばれたら 0 を返す。
 324 #
 325 # 前回 update_timestamp() が呼ばれた時刻と異なる時刻に
 326 # 再度 update_timestamp() が呼ばれたら 1 を返す。
 327 #
 328 sub update_timestamp{
 329         my $me = shift;
 330         my $time = shift;
 331
 332         if($me->{timestamp} != $time){
 333                 $me->{timestamp} = $time;
 334                 return 1;
 335         }
 336
 337         return 0;
 338 }
 339
 340 1;