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