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#
35use strict;
36use Socket;
37
38use vars qw($VERSION %IRSSI);
39use 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
55Irssi::settings_add_str('xqf', 'xqfLaunchInfo' => $ENV{HOME}.'/.qf/LaunchInfo.txt');
56Irssi::settings_add_str('xqf', 'xqfLicqFifo' => $ENV{HOME}.'/.licq/licq_fifo');
57Irssi::settings_add_str('xqf', 'xqfChannels', 'foo|bar');
58Irssi::settings_add_str('xqf', 'xqfAwayMessage', 'Playing $game ($mod) @ $name ($addr)');
59Irssi::settings_add_bool('xqf', 'xqfSetLicq', 0);
60Irssi::signal_add_last("message public", "xqfPing");
61
62# global vars
63my ($game, $name, $addr, $mod);
64my %xqfAway;
65my $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);
66
67# remove LaunchInfo on startup
68if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
69  unlink Irssi::settings_get_str('xqfLaunchInfo');
70}
71
72# /xqf: handles returning from games
73command_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
91sub 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
108sub 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
134sub 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
154sub 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
177sub 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
198sub 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
239