ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/irc.ext
Revision: 1.14
Committed: Tue Sep 23 14:41:26 2008 UTC (15 years, 8 months ago) by elmex
Branch: MAIN
CVS Tags: rel-2_72, rel-2_73, rel-2_76, rel-2_74, rel-2_75
Changes since 1.13: +24 -16 lines
Log Message:
ported from Net::IRC3 to AnyEvent::IRC.

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     use Time::HiRes;
4 elmex 1.14 use AnyEvent::IRC::Client;
5     use AnyEvent::IRC::Util;
6 root 1.1
7     # requires: commands.ext
8    
9     return unless exists $cf::CFG{irc_server};
10    
11 root 1.12 my $BOTSERVER = $cf::CFG{irc_server} || "localhost";
12     my $BOTPORT = $cf::CFG{irc_port} || 6667;
13     my $BOTNAME = $cf::CFG{irc_nick} || "server";
14     my $BOTCHAN = $cf::CFG{irc_chan} || "cf";
15 root 1.1
16     my $CON; # the connection
17    
18     sub unload {
19     $CON->disconnect if $CON;
20     undef $CON;
21     }
22    
23     sub do_notice {
24     my ($msg) = @_;
25    
26     utf8::encode $msg;
27 elmex 1.14 $CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, $msg)
28 root 1.1 if $CON;
29     }
30    
31     sub users {
32     $CON
33     ? grep $_ ne $CON->nick, keys %{ $CON->channel_list->{$BOTCHAN} || {} }
34     : ()
35     }
36    
37     sub handle_fcmd {
38     my ($name, $me, $msg) = @_;
39    
40     if ($msg eq "!who") {
41 root 1.6 # clobbers irc, http is available
42 elmex 1.8 do_notice "see http://www.deliantra.net/userlist.crossfire.schmorp.de.html";
43 root 1.6 # do_notice $_
44     # for ext::commands::who_listing (0, ".");
45 root 1.1
46     } elsif ($msg =~ /^\!tell/) {
47     my (undef, $target, $tmsg) = split / /, $msg, 3;
48    
49     if (my $other = cf::player::find_active $target) {
50    
51     if ($tmsg) {
52     if ($me eq $target) {
53 elmex 1.14 $CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, "$me: You are talking to yourself, you freak!");
54 root 1.1 } elsif ($other->ob->{ext_ignore_tell}{$me} >= time) {
55 elmex 1.14 $CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, "$me: $target ignores what you say. Give up on it.");
56 root 1.1 } else {
57     cf::LOG cf::llevDebug, sprintf "TELL [%s/%s>%s] %s\n", $name, $me, $target, $tmsg;
58    
59 elmex 1.7 $other->ns->send_msg (ext::chat::tell_channel ("$name/$me"), "$name/$me tells you: $tmsg", cf::NDI_DK_ORANGE | cf::NDI_DEF);
60 root 1.1 }
61     } else {
62     do_notice "$me: What do you want to tell $target?";
63     }
64    
65     }
66     }
67     }
68    
69     sub check_connection {
70     return if $CON;
71    
72 elmex 1.14 $CON = AnyEvent::IRC::Client->new;
73     $CON->connect ($BOTSERVER, $BOTPORT, {
74     nick => $BOTNAME,
75     user => $BOTNAME,
76     real => 'deliantra server'
77     });
78 root 1.1 $CON->send_srv (JOIN => undef, $BOTCHAN);
79     $CON->reg_cb (
80     irc_privmsg => sub {
81     my ($con, $msg) = @_;
82     my $name = 'irc';
83 elmex 1.14 my $nick = AnyEvent::IRC::Util::prefix_nick ($msg);
84 root 1.1 my $NOW = Time::HiRes::time;
85 root 1.2
86 elmex 1.14 my $tmsg = $msg->{params}->[-1];
87 root 1.1 $tmsg =~ s/\x01[^\x01]*\x01//g;
88     $tmsg =~ s/\015?\012/ /g;
89 root 1.2
90     utf8::decode $tmsg;
91    
92 root 1.1 if ($tmsg =~ /^\!/) {
93     handle_fcmd ($name, $nick, $tmsg);
94     } elsif ($tmsg =~ m/\S/) {
95 root 1.11 $_->ns->send_msg ($cf::CHAT_CHANNEL,
96 root 1.3 "$name/".$nick." chats: $tmsg", cf::NDI_BLUE | cf::NDI_DEF
97 root 1.13 ) for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW } cf::player::list;
98 root 1.10 cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", "$name/$nick", $tmsg;
99 root 1.1 }
100     },
101 elmex 1.14 connect => sub {
102     warn "IRC: connected to IRC server: $BOTSERVER:$BOTPORT\n";
103     },
104     registered => sub {
105     warn "IRC: successfully logged into IRC server: $BOTSERVER:$BOTPORT\n";
106     },
107     error => sub {
108     my ($con, $code, $message) = @_;
109     warn "IRC: IRC ERROR ($code) $message\n";
110     },
111 root 1.1 disconnect => sub {
112     my ($con, $reason) = @_;
113 elmex 1.14 warn "IRC: disconnect: $reason\n";
114 root 1.1 undef $CON;
115     }
116     );
117     }
118    
119 root 1.9 our $RECONNECT = cf::periodic 30, Coro::unblock_sub {
120     check_connection;
121     };
122 root 1.1