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};

our $BOTSERVER = $cf::CFG{irc_server};
our $BOTPORT   = $cf::CFG{irc_port};
our $BOTNAME   = $cf::CFG{irc_nick};
our $BOTCHAN   = $cf::CFG{irc_chan};

our $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->set_exception_cb (sub {
      my ($exp, $ev) = @_;
      warn "IRC: IRC EXCEPTION (event $ev): $exp\n";
   });
   $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 = length $BOTSERVER && cf::periodic 30, Coro::unblock_sub {
   check_connection;
};

Revision:	1.18
Committed:	Tue Jan 5 08:35:25 2010 UTC (14 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	rel-2_93
Changes since 1.17:	+6 -6 lines
Log Message:	* empty log message *
#	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.18	our $BOTSERVER = $cf::CFG{irc_server};
12			our $BOTPORT = $cf::CFG{irc_port};
13			our $BOTNAME = $cf::CFG{irc_nick};
14			our $BOTCHAN = $cf::CFG{irc_chan};
15	root	1.1
16	root	1.18	our $CON; # the connection
17	root	1.1
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	elmex	1.17	$CON->set_exception_cb (sub {
74			my ($exp, $ev) = @_;
75			warn "IRC: IRC EXCEPTION (event $ev): $exp\n";
76			});
77	elmex	1.14	$CON->connect ($BOTSERVER, $BOTPORT, {
78			nick => $BOTNAME,
79			user => $BOTNAME,
80			real => 'deliantra server'
81			});
82	root	1.1	$CON->send_srv (JOIN => undef, $BOTCHAN);
83			$CON->reg_cb (
84			irc_privmsg => sub {
85			my ($con, $msg) = @_;
86			my $name = 'irc';
87	elmex	1.14	my $nick = AnyEvent::IRC::Util::prefix_nick ($msg);
88	root	1.1	my $NOW = Time::HiRes::time;
89	root	1.2
90	elmex	1.15	my $tmsg = filter_colors ($msg->{params}->[-1]);
91	root	1.1	$tmsg =~ s/\x01[^\x01]*\x01//g;
92			$tmsg =~ s/\015?\012/ /g;
93	root	1.2
94			utf8::decode $tmsg;
95
96	root	1.1	if ($tmsg =~ /^\!/) {
97			handle_fcmd ($name, $nick, $tmsg);
98			} elsif ($tmsg =~ m/\S/) {
99	root	1.11	$_->ns->send_msg ($cf::CHAT_CHANNEL,
100	root	1.3	"$name/".$nick." chats: $tmsg", cf::NDI_BLUE \| cf::NDI_DEF
101	root	1.13	) for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW } cf::player::list;
102	root	1.10	cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", "$name/$nick", $tmsg;
103	root	1.1	}
104			},
105	elmex	1.14	connect => sub {
106	elmex	1.16	my ($con, $error) = @_;
107
108			if ($error) {
109			warn "IRC: CONNECT ERROR to IRC server: $BOTSERVER:$BOTPORT: $error\n";
110			undef $CON;
111
112			} else {
113			warn "IRC: connected to IRC server: $BOTSERVER:$BOTPORT\n";
114			}
115	elmex	1.14	},
116			registered => sub {
117			warn "IRC: successfully logged into IRC server: $BOTSERVER:$BOTPORT\n";
118			},
119			error => sub {
120			my ($con, $code, $message) = @_;
121			warn "IRC: IRC ERROR ($code) $message\n";
122			},
123	root	1.1	disconnect => sub {
124			my ($con, $reason) = @_;
125	elmex	1.14	warn "IRC: disconnect: $reason\n";
126	root	1.1	undef $CON;
127			}
128			);
129			}
130
131	root	1.18	our $RECONNECT = length $BOTSERVER && cf::periodic 30, Coro::unblock_sub {
132	root	1.9	check_connection;
133			};
134	root	1.1