html/xqf.pl
1 # $Id: xqf.pl,v 0.14 2004/07/03 14:52:50 mizerou Exp $
2 #
3 # XQF to Irssi/Licq script. Idea from an X-Chat script (xqf-xchat).
4 #
5 # Portions of away_verbose used with permission from Koenraad Heijlen.
6 #
7 # ChangeLog:
8 # 0.14:
9 # - !aping lookups coded (uses Socket)
10 # - bugfix: when passing stuff to licq_fifo and licq not running
11 # 0.13:
12 # - first public release, updates to follow.
13 # - remove control codes in licq away message
14 # 0.12:
15 # - incorporated a lightweight hack of away_verbose
16 # - no longer uses 'awe' and 'gone', all internally handled
17 # - some servers use whitespace in beginning of name, fixed
18 # - case-insensitive variables in setting 'xqfAwayMessage'
19 # - redundant settings removed, code cleanups
20 # 0.11:
21 # - licq support added
22 # - uses the 'awe' and 'gone' commands from away_verbose for now
23 # 0.10:
24 # - basics completed
25 #
26 # TODO:
27 # - a way to detect when you're back from the game?
28 # - timer checks to update licq and irssi (compare server addr)?
29 # - plans to convert mIRC script 'autoping' to perl (parts of it)
30 #
31 # Bugs/Ideas/Improvements:
32 # - report the above to mizerou @ irc.freenode.net/#fiend
33 # or irc.enterthegame.com/#fiend
34 #
35 use strict;
36 use Socket;
37
38 use vars qw($VERSION %IRSSI);
39 use Irssi qw(command_bind active_win);
40
41 $VERSION = '0.14';
42 %IRSSI = (
43 authors => 'mizerou',
44 contact => 'mizerou@telus.net',
45 name => 'XQF',
46 description => 'automatically sends xqf data to irssi and optionally licq',
47 license => 'GPLv2',
48 url => 'none',
49 changed => 'Sat June 05 05:12 MST 2004',
50 modules => 'Socket',
51 commands => 'xqf'
52 );
53
54 # setup irssi settings
55 Irssi::settings_add_str('xqf', 'xqfLaunchInfo' => $ENV{HOME}.'/.qf/LaunchInfo.txt');
56 Irssi::settings_add_str('xqf', 'xqfLicqFifo' => $ENV{HOME}.'/.licq/licq_fifo');
57 Irssi::settings_add_str('xqf', 'xqfChannels', 'foo|bar');
58 Irssi::settings_add_str('xqf', 'xqfAwayMessage', 'Playing $game ($mod) @ $name ($addr)');
59 Irssi::settings_add_bool('xqf', 'xqfSetLicq', 0);
60 Irssi::signal_add_last("message public", "xqfPing");
61
62 # global vars
63 my ($game, $name, $addr, $mod);
64 my %xqfAway;
65 my $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);
66
67 # remove LaunchInfo on startup
68 if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
69 unlink Irssi::settings_get_str('xqfLaunchInfo');
70 }
71
72 # /xqf: handles returning from games
73 command_bind xqf => sub {
74 if ($xqfAway{'away'}) {
75 my (@servers) = Irssi::servers();
76 if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
77 unlink Irssi::settings_get_str('xqfLaunchInfo');
78 }
79 $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);
80 $servers[0]->command("AWAY");
81 xqfBack();
82 return;
83 } else {
84 active_win->print("XQF\\ You aren't currently playing a game.");
85 return;
86 }
87 return 0;
88 };
89
90 # checks if user has launched a game from xqf
91 sub checkLaunchInfo {
92 if (!-e Irssi::settings_get_str('xqfLaunchInfo')) {
93 $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo' , undef);
94 return;
95 } else {
96 my (@servers) = Irssi::servers();
97 Irssi::timeout_remove($timeout);
98 my $xqfMessage = fetchLaunchInfo();
99 $servers[0]->command("AWAY " . $xqfMessage);
100 xqfAway($xqfMessage);
101 active_win->print("XQF\\ Please type /xqf when you have finished playing.");
102 return;
103 }
104 return 0;
105 }
106
107 # parses and returns data from LaunchInfo.txt
108 sub fetchLaunchInfo {
109 my $reply;
110
111 open(FH, "<".Irssi::settings_get_str('xqfLaunchInfo'));
112 my @LaunchInfo = <FH>;
113 close (FH);
114
115 foreach my $line (@LaunchInfo) {
116 ($game = $line) =~ s/^GameType (.+)\n/$1/ if ($line =~ /^GameType/);
117 ($name = $line) =~ s/^ServerName (.+)\n/$1/ if ($line =~ /^ServerName/);
118 ($addr = $line) =~ s/^ServerAddr (.+)\n/$1/ if ($line =~ /^ServerAddr/);
119 ($mod = $line) =~ s/^ServerMod (.+)\n/$1/ if ($line =~ /^ServerMod/);
120 }
121 s/^\s+// for ($game, $name, $addr, $mod);
122
123 $reply = Irssi::settings_get_str('xqfAwayMessage');
124 $reply =~ s/(\$\w+)/lc($1)/eego; # case insensitive
125 return ($reply); # return the users custom reply
126 }
127
128 #
129 # functions below were borrowed from away_verbose.pl and modified to suit my needs
130 # used with permission from Koenraad Heijlen <koenraad@ulyssis.org>
131 #
132
133 # converts unix time into human readable format
134 sub xqfSecs2Text {
135 my $xqfAwayTexts = "wk,wks,day,days,hr,hrs,min,mins,sec,secs";
136 my ($secs) = @_;
137 my ($wk_,$wks_,$day_,$days_,$hr_,$hrs_,$min_,$mins_,$sec_,$secs_) = (0,1,2,3,4,5,6,7,8,9,10);
138 my @texts = split(/,/, $xqfAwayTexts);
139
140 my $mins = int($secs / 60); $secs -= ($mins * 60);
141 my $hrs = int($mins / 60); $mins -= ($hrs * 60);
142 my $days = int($hrs / 24); $hrs -= ($days * 24);
143 my $wks = int($days / 7); $days -= ($wks * 7);
144 my $text = (($wks > 0) ? (($wks > 1) ? "$wks $texts[$wks_] " : "$wks $texts[$wk_] ") : "");
145 $text .= (($days > 0) ? (($days > 1) ? "$days $texts[$days_] " : "$days $texts[$day_] ") : "");
146 $text .= (($hrs > 0) ? (($hrs > 1) ? "$hrs $texts[$hrs_] " : "$hrs $texts[$hr_] ") : "");
147 $text .= (($mins > 0) ? (($mins > 1) ? "$mins $texts[$mins_] " : "$mins $texts[$min_] ") : "");
148 $text .= (($secs > 0) ? (($secs > 1) ? "$secs $texts[$secs_] " : "$secs $texts[$sec_] ") : "");
149 $text =~ s/ $//;
150 return ($text);
151 }
152
153 # sets away status on irssi and licq
154 sub xqfAway {
155 my ($text, $witem) = @_;
156 my $xqfChannels = Irssi::settings_get_str('xqfChannels');
157
158 $xqfAway{'time'} = time;
159 $xqfAway{'reason'} = "$text";
160 $xqfAway{'away'} = 1;
161 foreach my $server (Irssi::servers) {
162 foreach my $chan ($server->channels) {
163 if ((($server->{chatnet} .":". $chan->{name}) =~ /$xqfChannels/i)) {
164 $server->command("DESCRIBE $chan->{name} is away: $text");
165 }
166 }
167 }
168
169 if (Irssi::settings_get_bool('xqfSetLicq')) {
170 $text =~ s/\p{IsCntrl}//g;
171 active_win->command("exec -name xqfLicq echo 'status na \"$text\"' > " . Irssi::settings_get_str('xqfLicqFifo')); # 0.14: bugfix
172 active_win->command("exec -close xqfLicq");
173 }
174 }
175
176 # returns from away status on irssi and licq
177 sub xqfBack {
178 my ($text) = @_;
179 my $xqfChannels = Irssi::settings_get_str('xqfChannels');
180
181 foreach my $server (Irssi::servers) {
182 foreach my $chan ($server->channels) {
183 if ((($server->{chatnet} .":". $chan->{name}) =~ /$xqfChannels/i)) {
184 $server->command("DESCRIBE $chan->{name} has returned from: $xqfAway{'reason'} after " . xqfSecs2Text(time - $xqfAway{'time'}));
185 }
186 }
187 }
188 if (Irssi::settings_get_bool('xqfSetLicq')) {
189 active_win->command("exec -name xqfLicq echo 'status online' > " . Irssi::settings_get_str('xqfLicqFifo')); # 0.14: bugfix
190 active_win->command("exec -close xqfLicq");
191 }
192 $xqfAway{'time'} = 0;
193 $xqfAway{'reason'} = "";
194 $xqfAway{'away'} = 0;
195 }
196
197 # handle !aping requests
198 sub xqfPing {
199 my ($server, $host, $nick, $address, $channel) = @_;
200 my ($xqfChannels) = Irssi::settings_get_str('xqfChannels');
201 my ($average_ping);
202
203 if ($channel !~ /$xqfChannels/i) { return; }
204 if ($host !~ /^!aping/) { return; }
205 $host =~ s/^!aping //;
206
207 if ($xqfAway{'away'}) {
208 $server->command("msg $channel No pinging while gaming");
209 return;
210 }
211
212 # we make sure the host is real
213 my ($inetaddr) = gethostbyname($host);
214 if (!$inetaddr) {
215 $server->command("msg $channel I can't find $host");
216 return;
217 }
218 my $addr = inet_ntoa(scalar gethostbyname($host));
219
220 my @ping = `/bin/ping -w 2 -i .5 -c 3 $addr`;
221 my $average_line = $ping[-1];
222
223 if ($average_line !~ m#^.+= \S+/(\S+)/\S+/.*#) {
224 if ($average_line !~ /^rtt.*/) {
225 $server->command("msg $channel Could not connect to $host");
226 return;
227 } else {
228 $server->command("msg $channel Could not parse results from ping");
229 return;
230 }
231 } else {
232 $average_ping = "${1}ms";
233 }
234 $server->command("msg $channel $host = $average_ping");
235 return;
236 }
237
238 # EOF