server/ext/irc.ext

#! perl

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