summaryrefslogtreecommitdiffstats
path: root/scripts/xqf.pl
blob: 2ea7a30a28def7184de0156f36090e69b9808aa2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
# $Id: xqf.pl,v 0.14 2004/07/03 14:52:50 mizerou Exp $
#
# XQF to Irssi/Licq script. Idea from an X-Chat script (xqf-xchat).
#
# Portions of away_verbose used with permission from Koenraad Heijlen.
#
# ChangeLog:
# 0.14:
#  - !aping lookups coded (uses Socket)
#  - bugfix: when passing stuff to licq_fifo and licq not running
# 0.13:
#  - first public release, updates to follow.
#  - remove control codes in licq away message
# 0.12:
#  - incorporated a lightweight hack of away_verbose
#    - no longer uses 'awe' and 'gone', all internally handled
#  - some servers use whitespace in beginning of name, fixed
#  - case-insensitive variables in setting 'xqfAwayMessage'
#  - redundant settings removed, code cleanups
# 0.11:
#  - licq support added
#  - uses the 'awe' and 'gone' commands from away_verbose for now
# 0.10:
#  - basics completed
#
# TODO:
#  - a way to detect when you're back from the game?
#  - timer checks to update licq and irssi (compare server addr)?
#  - plans to convert mIRC script 'autoping' to perl (parts of it)
#
# Bugs/Ideas/Improvements:
#  - report the above to mizerou @ irc.freenode.net/#fiend
#	or irc.enterthegame.com/#fiend
#
use strict;
use Socket;

use vars qw($VERSION %IRSSI);
use Irssi qw(command_bind active_win);

$VERSION = '0.14';
%IRSSI = (
    authors	=> 'mizerou',
    contact	=> 'mizerou@telus.net',
    name	=> 'XQF',
    description	=> 'automatically sends xqf data to irssi and optionally licq',
    license	=> 'GPLv2',
    url		=> 'none',
    changed	=> 'Sat June 05 05:12 MST 2004',
    modules	=> 'Socket',
    commands	=> 'xqf'
);

# setup irssi settings
Irssi::settings_add_str('xqf', 'xqfLaunchInfo' => $ENV{HOME}.'/.qf/LaunchInfo.txt');
Irssi::settings_add_str('xqf', 'xqfLicqFifo' => $ENV{HOME}.'/.licq/licq_fifo');
Irssi::settings_add_str('xqf', 'xqfChannels', 'foo|bar');
Irssi::settings_add_str('xqf', 'xqfAwayMessage', 'Playing $game ($mod) @ $name ($addr)');
Irssi::settings_add_bool('xqf', 'xqfSetLicq', 0);
Irssi::signal_add_last("message public", "xqfPing");

# global vars
my ($game, $name, $addr, $mod);
my %xqfAway;
my $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);

# remove LaunchInfo on startup
if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
  unlink Irssi::settings_get_str('xqfLaunchInfo');
}

# /xqf: handles returning from games
command_bind xqf => sub {
  if ($xqfAway{'away'}) {
    my (@servers) = Irssi::servers();
    if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
      unlink Irssi::settings_get_str('xqfLaunchInfo');
    }
    $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);
    $servers[0]->command("AWAY");
    xqfBack();
    return;
  } else {
    active_win->print("XQF\\ You aren't currently playing a game.");
    return;
  }
  return 0;
};

# checks if user has launched a game from xqf
sub checkLaunchInfo {
  if (!-e Irssi::settings_get_str('xqfLaunchInfo')) {
    $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo' , undef);
    return;
  } else {
    my (@servers) = Irssi::servers();
    Irssi::timeout_remove($timeout);
    my $xqfMessage = fetchLaunchInfo();
    $servers[0]->command("AWAY " . $xqfMessage);
    xqfAway($xqfMessage);
    active_win->print("XQF\\ Please type /xqf when you have finished playing.");
    return;
  }
  return 0;
}

# parses and returns data from LaunchInfo.txt
sub fetchLaunchInfo {
  my $reply;

  open(FH, "<", Irssi::settings_get_str('xqfLaunchInfo'));
  my @LaunchInfo = <FH>;
  close (FH);

  foreach my $line (@LaunchInfo) {
    ($game = $line) =~ s/^GameType (.+)\n/$1/ if ($line =~ /^GameType/);
    ($name = $line) =~ s/^ServerName (.+)\n/$1/ if ($line =~ /^ServerName/);
    ($addr = $line) =~ s/^ServerAddr (.+)\n/$1/ if ($line =~ /^ServerAddr/);
    ($mod = $line) =~ s/^ServerMod (.+)\n/$1/ if ($line =~ /^ServerMod/);
  }
  s/^\s+// for ($game, $name, $addr, $mod);

  $reply = Irssi::settings_get_str('xqfAwayMessage');
  $reply =~ s/(\$\w+)/lc($1)/eego;	# case insensitive
  return ($reply);			# return the users custom reply
}

#
# functions below were borrowed from away_verbose.pl and modified to suit my needs
# used with permission from Koenraad Heijlen <koenraad@ulyssis.org>
#

# converts unix time into human readable format
sub xqfSecs2Text {
  my $xqfAwayTexts = "wk,wks,day,days,hr,hrs,min,mins,sec,secs";
  my ($secs) = @_;
  my ($wk_,$wks_,$day_,$days_,$hr_,$hrs_,$min_,$mins_,$sec_,$secs_) = (0,1,2,3,4,5,6,7,8,9,10);
  my @texts = split(/,/, $xqfAwayTexts);

  my $mins = int($secs / 60); $secs -= ($mins * 60);
  my $hrs = int($mins / 60); $mins -= ($hrs * 60);
  my $days = int($hrs / 24); $hrs -= ($days * 24);
  my $wks = int($days / 7); $days -= ($wks * 7);
  my $text = (($wks > 0) ? (($wks > 1) ? "$wks $texts[$wks_] " : "$wks $texts[$wk_] ") : "");
  $text .= (($days > 0) ? (($days > 1) ? "$days $texts[$days_] " : "$days $texts[$day_] ") : "");
  $text .= (($hrs > 0) ? (($hrs > 1) ? "$hrs $texts[$hrs_] " : "$hrs $texts[$hr_] ")  : "");
  $text .= (($mins > 0) ? (($mins > 1) ? "$mins $texts[$mins_] " : "$mins $texts[$min_] ") : "");
  $text .= (($secs > 0) ? (($secs > 1) ? "$secs $texts[$secs_] " : "$secs $texts[$sec_] ") : "");
  $text =~ s/ $//;
  return ($text);
}

# sets away status on irssi and licq
sub xqfAway {
  my ($text, $witem) = @_;
  my $xqfChannels = Irssi::settings_get_str('xqfChannels');

  $xqfAway{'time'} = time;
  $xqfAway{'reason'} = "$text";
  $xqfAway{'away'} = 1;
  foreach my $server (Irssi::servers) {
    foreach my $chan ($server->channels) {
      if ((($server->{chatnet} .":". $chan->{name}) =~ /$xqfChannels/i)) {
        $server->command("DESCRIBE $chan->{name} is away: $text");
      }
    }
  }

  if (Irssi::settings_get_bool('xqfSetLicq')) {
    $text =~ s/\p{IsCntrl}//g;
    active_win->command("exec -name xqfLicq echo 'status na \"$text\"' > " . Irssi::settings_get_str('xqfLicqFifo')); # 0.14: bugfix
    active_win->command("exec -close xqfLicq");    
  }
}

# returns from away status on irssi and licq
sub xqfBack { 
  my ($text) = @_;
  my $xqfChannels = Irssi::settings_get_str('xqfChannels');

  foreach my $server (Irssi::servers) {
    foreach my $chan ($server->channels) {
      if ((($server->{chatnet} .":". $chan->{name}) =~ /$xqfChannels/i)) {
        $server->command("DESCRIBE $chan->{name} has returned from: $xqfAway{'reason'} after " . xqfSecs2Text(time - $xqfAway{'time'}));
      }
    }
  }
  if (Irssi::settings_get_bool('xqfSetLicq')) {
    active_win->command("exec -name xqfLicq echo 'status online' > " . Irssi::settings_get_str('xqfLicqFifo')); # 0.14: bugfix
    active_win->command("exec -close xqfLicq");
  }
  $xqfAway{'time'} = 0;
  $xqfAway{'reason'} = "";
  $xqfAway{'away'} = 0;
}
        
# handle !aping requests
sub xqfPing {
  my ($server, $host, $nick, $address, $channel) = @_;
  my ($xqfChannels) = Irssi::settings_get_str('xqfChannels');
  my ($average_ping);

  if ($channel !~ /$xqfChannels/i) { return; }
  if ($host !~ /^!aping/) { return; }
  $host =~ s/^!aping //;

  if ($xqfAway{'away'}) {
    $server->command("msg $channel No pinging while gaming");
    return;
  }

  # we make sure the host is real
  my ($inetaddr) = gethostbyname($host);
  if (!$inetaddr) {
    $server->command("msg $channel I can't find $host");
    return;
  }
  my $addr = inet_ntoa(scalar gethostbyname($host));

  my @ping = `/bin/ping -w 2 -i .5 -c 3 $addr`;
  my $average_line = $ping[-1];

  if ($average_line !~ m#^.+= \S+/(\S+)/\S+/.*#) {
    if ($average_line !~ /^rtt.*/) {
      $server->command("msg $channel Could not connect to $host");
      return;
    } else {
      $server->command("msg $channel Could not parse results from ping");
      return;
    }
  } else {
    $average_ping = "${1}ms";
  }
  $server->command("msg $channel $host = $average_ping");
  return;
}

# EOF