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

CONF BOTSERVER : irc_server = undef;
CONF BOTPORT   : irc_port   = undef;
CONF BOTNAME   : irc_nick   = undef;
CONF BOTCHAN   : irc_chan   = undef;

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} || {} }
      : ()
}

# for nicklist monitoring, #d# should be done event-based
our %NICKLIST;
our $NICKLIST = AE::timer 20, 59.17, sub {
   return unless defined &ext::nickmon::NT_OTHER;

   my %NEXTLIST;
   for (users) {
      &ext::nickmon::upd ("irc/$_", &ext::nickmon::NT_OTHER, "irc")
         unless exists $NICKLIST{$_};

      delete $NICKLIST{$_};
      undef $NEXTLIST{$_};
   }

   &ext::nickmon::del ("irc/$_")
      for keys %NICKLIST;

   %NICKLIST = %NEXTLIST;
};

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) = @_;
      cf::error "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) {
            cf::error "IRC: CONNECT ERROR to IRC server: $BOTSERVER:$BOTPORT: $error\n";
            undef $CON;

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

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

Revision:	1.21
Committed:	Sat Nov 10 03:43:01 2012 UTC (11 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.20:	+21 -1 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.20	CONF BOTSERVER : irc_server = undef;
12			CONF BOTPORT : irc_port = undef;
13			CONF BOTNAME : irc_nick = undef;
14			CONF BOTCHAN : irc_chan = undef;
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	root	1.21	: ()
35	root	1.1	}
36
37	root	1.21	# for nicklist monitoring, #d# should be done event-based
38			our %NICKLIST;
39			our $NICKLIST = AE::timer 20, 59.17, sub {
40			return unless defined &ext::nickmon::NT_OTHER;
41
42			my %NEXTLIST;
43			for (users) {
44			&ext::nickmon::upd ("irc/$_", &ext::nickmon::NT_OTHER, "irc")
45			unless exists $NICKLIST{$_};
46
47			delete $NICKLIST{$_};
48			undef $NEXTLIST{$_};
49			}
50
51			&ext::nickmon::del ("irc/$_")
52			for keys %NICKLIST;
53
54			%NICKLIST = %NEXTLIST;
55			};
56
57	root	1.1	sub handle_fcmd {
58			my ($name, $me, $msg) = @_;
59
60			if ($msg eq "!who") {
61	root	1.6	# clobbers irc, http is available
62	elmex	1.8	do_notice "see http://www.deliantra.net/userlist.crossfire.schmorp.de.html";
63	root	1.6	# do_notice $_
64			# for ext::commands::who_listing (0, ".");
65	root	1.1
66			} elsif ($msg =~ /^\!tell/) {
67			my (undef, $target, $tmsg) = split / /, $msg, 3;
68
69			if (my $other = cf::player::find_active $target) {
70
71			if ($tmsg) {
72			if ($me eq $target) {
73	elmex	1.14	$CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, "$me: You are talking to yourself, you freak!");
74	root	1.1	} elsif ($other->ob->{ext_ignore_tell}{$me} >= time) {
75	elmex	1.14	$CON->send_chan ($BOTCHAN, NOTICE => $BOTCHAN, "$me: $target ignores what you say. Give up on it.");
76	root	1.1	} else {
77			cf::LOG cf::llevDebug, sprintf "TELL [%s/%s>%s] %s\n", $name, $me, $target, $tmsg;
78
79	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);
80	root	1.1	}
81			} else {
82			do_notice "$me: What do you want to tell $target?";
83			}
84
85			}
86			}
87			}
88
89			sub check_connection {
90			return if $CON;
91
92	elmex	1.14	$CON = AnyEvent::IRC::Client->new;
93	elmex	1.17	$CON->set_exception_cb (sub {
94			my ($exp, $ev) = @_;
95	root	1.19	cf::error "IRC: IRC EXCEPTION (event $ev): $exp\n";
96	elmex	1.17	});
97	elmex	1.14	$CON->connect ($BOTSERVER, $BOTPORT, {
98			nick => $BOTNAME,
99			user => $BOTNAME,
100			real => 'deliantra server'
101			});
102	root	1.1	$CON->send_srv (JOIN => undef, $BOTCHAN);
103			$CON->reg_cb (
104			irc_privmsg => sub {
105			my ($con, $msg) = @_;
106			my $name = 'irc';
107	elmex	1.14	my $nick = AnyEvent::IRC::Util::prefix_nick ($msg);
108	root	1.1	my $NOW = Time::HiRes::time;
109	root	1.2
110	elmex	1.15	my $tmsg = filter_colors ($msg->{params}->[-1]);
111	root	1.1	$tmsg =~ s/\x01[^\x01]*\x01//g;
112			$tmsg =~ s/\015?\012/ /g;
113	root	1.2
114			utf8::decode $tmsg;
115
116	root	1.1	if ($tmsg =~ /^\!/) {
117			handle_fcmd ($name, $nick, $tmsg);
118			} elsif ($tmsg =~ m/\S/) {
119	root	1.11	$_->ns->send_msg ($cf::CHAT_CHANNEL,
120	root	1.3	"$name/".$nick." chats: $tmsg", cf::NDI_BLUE \| cf::NDI_DEF
121	root	1.13	) for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW } cf::player::list;
122	root	1.10	cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", "$name/$nick", $tmsg;
123	root	1.1	}
124			},
125	elmex	1.14	connect => sub {
126	elmex	1.16	my ($con, $error) = @_;
127
128			if ($error) {
129	root	1.19	cf::error "IRC: CONNECT ERROR to IRC server: $BOTSERVER:$BOTPORT: $error\n";
130	elmex	1.16	undef $CON;
131
132			} else {
133	root	1.19	cf::info "IRC: connected to IRC server: $BOTSERVER:$BOTPORT\n";
134	elmex	1.16	}
135	elmex	1.14	},
136			registered => sub {
137	root	1.19	cf::info "IRC: successfully logged into IRC server: $BOTSERVER:$BOTPORT\n";
138	elmex	1.14	},
139			error => sub {
140			my ($con, $code, $message) = @_;
141	root	1.19	cf::error "IRC: IRC ERROR ($code) $message\n";
142	elmex	1.14	},
143	root	1.1	disconnect => sub {
144			my ($con, $reason) = @_;
145	root	1.19	cf::warn "IRC: disconnect: $reason\n";
146	root	1.1	undef $CON;
147			}
148			);
149			}
150
151	root	1.18	our $RECONNECT = length $BOTSERVER && cf::periodic 30, Coro::unblock_sub {
152	root	1.9	check_connection;
153			};
154	root	1.1