lib/Keitairc/IrcBuffer.pm

   1 # -*-perl-*-
   2 # Keitairc::IrcBuffer
   3 # $Id: IrcBuffer.pm,v 1.10 2008-02-25 16:52:20 morimoto Exp $
   4 # $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/IrcBuffer.pm,v $
   5 #
   6 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
   7 # This program is covered by the GNU General Public License 2
   8
   9 package Keitairc::IrcBuffer;
  10 use strict;
  11 use Encode;
  12 use Data::Dumper;
  13
  14 ################################################################
  15 sub new{
  16         my $proto = shift;
  17         my $arg = shift;
  18         my $me = {};
  19
  20         $me->{history} = $arg->{history};
  21
  22         # join しているchannelの名称を記録するハッシュ (jis)
  23         $me->{cid2name} = {};
  24         $me->{name2cid} = {};
  25
  26         # join しているtopicの名称を記録するハッシュ (jis)
  27         $me->{topic} = {};
  28
  29         $me->{nicks} = {};
  30
  31         # チャネルの会話内容を記録するハッシュ (euc-jp)
  32         $me->{buffer} = {};
  33         $me->{unread} = {};
  34
  35         # 各チャネルの最終発言時刻
  36         $me->{mtime} = {};
  37         # 各チャネルの未読行数
  38         $me->{unread_lines} = {};
  39
  40         # chk
  41         $me->{message_added} = 0;
  42
  43         bless $me;
  44 }
  45
  46 ################################################################
  47 sub add_nick{
  48         my($me, $cid, $nick, $chop, $realname) = @_;
  49         $me->{nicks}->{$cid}->{$nick}->{realname} = $realname;
  50         $me->{nicks}->{$cid}->{$nick}->{chop} = $chop;
  51 }
  52
  53 ################################################################
  54 sub list_nick{
  55         my($me, $cid, $nick, $chop, $realname) = @_;
  56         keys %{$me->{nicks}->{$cid}};
  57 }
  58
  59 ################################################################
  60 sub remove_nick{
  61         my($me, $cid, $nick) = @_;
  62         delete $me->{nicks}->{$cid}->{$nick};
  63 }
  64
  65 ################################################################
  66 sub get_nick_realname{
  67         my($me, $cid, $nick) = @_;
  68         $me->{nicks}->{$cid}->{$nick}->{realname};
  69 }
  70
  71 ################################################################
  72 sub op_nick{
  73         my($me, $cid, $nick) = @_;
  74         if(defined $me->{nicks}->{$cid}){
  75                 if(defined $me->{nicks}->{$cid}->{$nick}){
  76                         $me->{nicks}->{$cid}->{$nick}->{chop} = 1;
  77                 }
  78         }
  79 }
  80
  81 ################################################################
  82 sub deop_nick{
  83         my($me, $cid, $nick) = @_;
  84         if(defined $me->{nicks}->{$cid}){
  85                 if(defined $me->{nicks}->{$cid}->{$nick}){
  86                         $me->{nicks}->{$cid}->{$nick}->{chop} = 0;
  87                 }
  88         }
  89 }
  90
  91 ################################################################
  92 sub get_nick_op{
  93         my($me, $cid, $nick) = @_;
  94         if(defined $me->{nicks}->{$cid}){
  95                 if(defined $me->{nicks}->{$cid}->{$nick}){
  96                         return $me->{nicks}->{$cid}->{$nick}->{chop};
  97                 }
  98         }
  99 }
 100
 101 ################################################################
 102 sub channels{
 103         my $me = shift;
 104         map {
 105                 $_
 106         }(sort
 107           {
 108                   $me->mtime($b) <=> $me->mtime($a)
 109           } keys %{$me->{cid2name}});
 110 }
 111
 112 ################################################################
 113 sub now{
 114         my ($sec, $min, $hour) = localtime(time);
 115         sprintf('%02d:%02d', $hour, $min);
 116 }
 117
 118 ################################################################
 119 # 生のiso-2022-jpのまま扱うこと。こういう仕様なのでしょうがない。
 120 sub name2cid{
 121         my($me, $name) = @_;
 122         $name =~ tr/A-Z[\\]^/a-z{|}~/;
 123
 124         unless(defined $me->{name2cid}->{$name}){
 125                 my @sort = sort { $a - $b } (keys %{$me->{cid2name}});
 126                 my $cid = 1 + pop @sort;
 127                 $me->{cid2name}->{$cid} = $name;
 128                 $me->{name2cid}->{$name} = $cid;
 129         }
 130
 131         $me->{name2cid}->{$name};
 132 }
 133
 134 ################################################################
 135 sub cid2name{
 136         my($me, $cid) = @_;
 137         $me->{cid2name}->{$cid};
 138 }
 139
 140 ################################################################
 141 sub part{
 142         my($me, $cid) = @_;
 143         delete $me->{cid2name}->{$cid};
 144 }
 145
 146 ################################################################
 147 sub join{
 148         my ($me, $name) = @_;
 149         my $cid = $me->name2cid($name);
 150         $me->{cid2name}->{$cid} = $name;
 151 }
 152
 153 ################################################################
 154 sub mtime{
 155         my($me, $cid) = @_;
 156         $me->{mtime}->{$cid};
 157 }
 158
 159 ################################################################
 160 sub message_added{
 161         my($me, $v) = @_;
 162         if(defined $v){
 163                 $me->{message_added} = $v;
 164         }
 165         $me->{message_added};
 166 }
 167
 168 ################################################################
 169 sub unread_lines{
 170         my($me, $cid) = @_;
 171         $me->{unread_lines}->{$cid};
 172 }
 173
 174 ################################################################
 175 sub unread{
 176         my($me, $cid) = @_;
 177         $me->{unread}->{$cid};
 178 }
 179
 180 ################################################################
 181 sub clear_unread{
 182         my($me, $cid) = @_;
 183         $me->{unread}->{$cid} = '';
 184         $me->{unread_lines}->{$cid} = 0;
 185 }
 186
 187 ################################################################
 188 sub topic{
 189         my($me, $cid, $topic) = @_;
 190         if(defined $topic){
 191                 $me->{topic}->{$cid} = $topic;
 192         }
 193         $me->{topic}->{$cid};
 194 }
 195
 196 ################################################################
 197 sub buffer{
 198         my($me, $cid) = @_;
 199         $me->{buffer}->{$cid};
 200 }
 201
 202 ################################################################
 203 # 引数の $msg は euc-jp, $channel は jis
 204 sub add_message{
 205         my($me, $cid, $message, $who) = @_;
 206
 207         if(length $who){
 208                 $message = sprintf('%s %s> %s', now(), $who, $message);
 209         }else{
 210                 $message = sprintf('%s %s', now(), $message);
 211         }
 212
 213         {
 214                 my @tmp = split("\n", $me->{buffer}->{$cid});
 215                 push @tmp, $message;
 216
 217                 if(@tmp > $me->{history}){
 218                         $me->{buffer}->{$cid} =
 219                                 CORE::join("\n", splice(@tmp, -$me->{history}));
 220                 }else{
 221                         $me->{buffer}->{$cid} = CORE::join("\n", @tmp);
 222                 }
 223         }
 224
 225         {
 226                 my @tmp = split("\n", $me->{unread}->{$cid});
 227                 push @tmp, $message;
 228
 229                 if(@tmp > $me->{history}){
 230                         $me->{unread}->{$cid} =
 231                                 CORE::join("\n", @tmp[1 .. $me->{history}]);
 232                 }else{
 233                         $me->{unread}->{$cid} = CORE::join("\n", @tmp);
 234                 }
 235
 236                 $me->{unread_lines}->{$cid} = scalar(@tmp);
 237         }
 238
 239         if($me->{unread_lines}->{$cid} > $me->{history}){
 240                 $me->{unread_lines}->{$cid} = $me->{history};
 241         }
 242
 243         $me->{mtime}->{$cid} = time;
 244 }
 245
 246 ################################################################
 247 # チャネル名称を短かくする
 248 sub compact_channel_name{
 249         my $me = shift;
 250         my $cid = shift;
 251         my $name = $me->cid2name($cid);
 252
 253         $name = decode('jis', $name);
 254
 255         # #name:*.jp を %name に
 256         if($name =~ s/:\*\.jp$//){
 257                 $name =~ s/^#/%/;
 258         }
 259
 260         # 末尾の単独の @ は取る (plumプラグインのmulticast.plm対策)
 261         $name =~ s/\@$//;
 262
 263         encode('shiftjis', $name);
 264 }
 265
 266 ################################################################
 267 sub simple_escape{
 268         my $me = shift;
 269         local($_) = shift;
 270         s/&/&amp;/g;
 271         s/>/&gt;/g;
 272         s/</&lt;/g;
 273         $_;
 274 }
 275
 276 ################################################################
 277 sub colorize{
 278         my $me = shift;
 279         local($_) = shift;
 280
 281         my %ct = (
 282                 1 => 'Black',
 283                 2 => '#000080', # Navy Blue
 284                 3 => 'Green',
 285                 4 => 'Red',
 286                 5 => 'Maroon',
 287                 6 => 'Purple',
 288                 7 => 'Olive',
 289                 8 => 'Yellow',
 290                 9 => '#32cd32', # Lime Green
 291                 10 => 'Teal',
 292                 11 => 'Aqua',
 293                 12 => '#4169e1', # Royal Blue
 294                 13 => '#ff69b4', # Hot Pink
 295                 14 => '#a9a9a9', # Dark Gray
 296                 15 => '#d3d3d3', # Light Gray
 297                 16 => 'White');
 298         my $colored = 0;
 299
 300         do{
 301                 if($colored){
 302                         s|\x03(\d{1,2})|sprintf('</font><font color="%s">', $ct{0+$1})|e;
 303                         if(s|\x03|</font>|){
 304                                 $colored = 0;
 305                         }
 306                 }else{
 307                         if(s|\x03(\d{1,2})|sprintf('<font color="%s">', $ct{0+$1})|e){
 308                                 $colored = 1;
 309                         }
 310                 }
 311         }while(m|\x03\d{1,2}|);
 312
 313         if($colored){
 314                 $_ .= '</font>';
 315         }
 316
 317         $_;
 318 }
 319
 320 1;