server/ext/irc.ext

#! perl

use Time::HiRes;
use AnyEvent::IRC::Client;
use AnyEvent::IRC::Util qw/filter_colors/;

# requires: commands.ext

return unless exists $cf::CFG{irc_server};

my $BOTSERVER = $cf::CFG{irc_server} || "localhost";
my $BOTPORT   = $cf::CFG{irc_port}   || 6667;
my $BOTNAME   = $cf::CFG{irc_nick}   || "server";
my $BOTCHAN   = $cf::CFG{irc_chan}   || "cf";

my $CON; # the connection

sub unload {
   $CON->disconnect if $CON;
   undef $CON;
}

sub do_notice {
   my ($msg) = @_;

   utf8::encode $msg;
   $CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, $msg)
      if $CON;
}

sub users {
   $CON
      ? grep $_ ne $CON->nick, keys %{ $CON->channel_list->{$BOTCHAN} || {} }
      : () 
}

sub handle_fcmd {
   my ($name, $me, $msg) = @_;

   if ($msg eq "!who") {
      # clobbers irc, http is available
      do_notice "see http://www.deliantra.net/userlist.crossfire.schmorp.de.html";
#      do_notice $_
#         for ext::commands::who_listing (0, ".");

   } elsif ($msg =~ /^\!tell/) {
      my (undef, $target, $tmsg) = split / /, $msg, 3;

      if (my $other = cf::player::find_active $target) {

         if ($tmsg) {
            if ($me eq $target) {
               $CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, "$me: You are talking to yourself, you freak!");
            } elsif ($other->ob->{ext_ignore_tell}{$me} >= time) {
               $CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, "$me: $target ignores what you say. Give up on it.");
            } else {
               cf::LOG cf::llevDebug, sprintf "TELL [%s/%s>%s] %s\n", $name, $me, $target, $tmsg;

               $other->ns->send_msg (ext::chat::tell_channel ("$name/$me"), "$name/$me tells you: $tmsg", cf::NDI_DK_ORANGE | cf::NDI_DEF);
            }
         } else {
            do_notice "$me: What do you want to tell $target?";
         }

      }
   }
}

sub check_connection {
   return if $CON;

   $CON = AnyEvent::IRC::Client->new;
   $CON->connect ($BOTSERVER, $BOTPORT, {
      nick => $BOTNAME,
      user => $BOTNAME,
      real => 'deliantra server'
   });
   $CON->send_srv (JOIN => undef, $BOTCHAN);
   $CON->reg_cb (
      irc_privmsg => sub {
         my ($con, $msg) = @_;
         my $name = 'irc';
         my $nick = AnyEvent::IRC::Util::prefix_nick ($msg);
         my $NOW = Time::HiRes::time;

         my $tmsg = filter_colors ($msg->{params}->[-1]);
         $tmsg =~ s/\x01[^\x01]*\x01//g;
         $tmsg =~ s/\015?\012/ /g;

         utf8::decode $tmsg;

         if ($tmsg =~ /^\!/) {
            handle_fcmd ($name, $nick, $tmsg);
         } elsif ($tmsg =~ m/\S/) {
            $_->ns->send_msg ($cf::CHAT_CHANNEL,
               "$name/".$nick." chats: $tmsg", cf::NDI_BLUE | cf::NDI_DEF
            ) for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW } cf::player::list;
            cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", "$name/$nick", $tmsg;
         }
      },
      connect => sub {
         my ($con, $error) = @_;

         if ($error) {
            warn "IRC: CONNECT ERROR to IRC server: $BOTSERVER:$BOTPORT: $error\n";
            undef $CON;

         } else {
            warn "IRC: connected to IRC server: $BOTSERVER:$BOTPORT\n";
         }
      },
      registered => sub {
         warn "IRC: successfully logged into IRC server: $BOTSERVER:$BOTPORT\n";
      },
      error => sub {
         my ($con, $code, $message) = @_;
         warn "IRC: IRC ERROR ($code) $message\n";
      },
      disconnect => sub {
         my ($con, $reason) = @_;
         warn "IRC: disconnect: $reason\n";
         undef $CON;
      }
   );
}

our $RECONNECT = cf::periodic 30, Coro::unblock_sub {
   check_connection;
};

Revision:	1.16
Committed:	Wed Mar 11 22:36:39 2009 UTC (15 years, 2 months ago) by elmex
Branch:	MAIN
CVS Tags:	rel-2_78
Changes since 1.15:	+9 -1 lines
Log Message:	fixed bug in connect error handling in IRC gateway.
#	User	Rev	Content
1	root	1.1	#! perl
2
3			use Time::HiRes;
4	elmex	1.14	use AnyEvent::IRC::Client;
5	elmex	1.15	use AnyEvent::IRC::Util qw/filter_colors/;
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.15	my $tmsg = filter_colors ($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	elmex	1.16	my ($con, $error) = @_;
103
104			if ($error) {
105			warn "IRC: CONNECT ERROR to IRC server: $BOTSERVER:$BOTPORT: $error\n";
106			undef $CON;
107
108			} else {
109			warn "IRC: connected to IRC server: $BOTSERVER:$BOTPORT\n";
110			}
111	elmex	1.14	},
112			registered => sub {
113			warn "IRC: successfully logged into IRC server: $BOTSERVER:$BOTPORT\n";
114			},
115			error => sub {
116			my ($con, $code, $message) = @_;
117			warn "IRC: IRC ERROR ($code) $message\n";
118			},
119	root	1.1	disconnect => sub {
120			my ($con, $reason) = @_;
121	elmex	1.14	warn "IRC: disconnect: $reason\n";
122	root	1.1	undef $CON;
123			}
124			);
125			}
126
127	root	1.9	our $RECONNECT = cf::periodic 30, Coro::unblock_sub {
128			check_connection;
129			};
130	root	1.1