← Back to branch summary

~ubuntu-branches/ubuntu/hoary/xpilot-extra/hoary

« back to all changes in this revision

Viewing changes to metapilot

  • Committer: Bazaar Package Importer
  • Author(s): Ben Armstrong
  • Date: 2001-12-18 13:43:32 UTC
  • Revision ID: james.westby@ubuntu.com-20011218134332-t87rvhcp1hhrnx3b
Tags: 4.4.3
Fixed build dep to use -Indep.

Show diffs side-by-side

added added

removed removed

Lines of Context:
metapilot
 
1
#!/usr/bin/perl -w
 
2
 
 
3
use strict;
 
4
use Socket;
 
5
 
 
6
 
 
7
# Define subroutines
 
8
 
 
9
sub show_help;
 
10
sub print_entry;
 
11
 
 
12
 
 
13
# Define variables
 
14
 
 
15
my (@playerlist, @serverlist, @maplist, %servers, %rank);
 
16
my ($home, $arg, $mode) = ($ENV{'HOME'}, "", 0);
 
17
my ($score, $server) = (0, "");
 
18
 
 
19
 
 
20
# Parse any command line arguments...
 
21
 
 
22
while (@ARGV)
 
23
{
 
24
  $arg = shift (@ARGV);
 
25
  
 
26
  show_help,                exit if $arg =~ /^-(-h(e(lp?)?)?|h)$/;
 
27
  $mode=1,                  next if $arg =~ /^-(-p(l(a(y(er?)?)?)?)?|p)$/;
 
28
  $mode=2,                  next if $arg =~ /^-(-s(e(r(v(er?)?)?)?)?|s)$/;
 
29
  $mode=3,                  next if $arg =~ /^-(-m(ap?)?|m)$/;
 
30
 
 
31
  parse_error ($arg),       exit if $arg =~ /^-/;
 
32
  
 
33
  push (@playerlist, $arg), next if $mode == 1;
 
34
  push (@serverlist, $arg), next if $mode == 2;
 
35
  push (@maplist, $arg),    next if $mode == 3;
 
36
}
 
37
 
 
38
 
 
39
 
 
40
# Find/Parse configuration file
 
41
 
 
42
if (open (CONFIGFILE, "$home/.var/config/x/xpilot/metapilot") ||
 
43
    open (CONFIGFILE, "$home/.metapilot") ||
 
44
    open (CONFIGFILE, "$home/.metapilotrc"))
 
45
{
 
46
  while (<CONFIGFILE>)
 
47
  {
 
48
    /^\s*(player|PLAYER|Player)\s*:\s*(.*)$/ && push @playerlist, $2;
 
49
    /^\s*(server|SERVER|Server)\s*:\s*(.*)$/ && push @serverlist, $2;
 
50
    /^\s*(map|MAP|Map)\s*:\s*(.*)$/ && push @maplist, $2;
 
51
  }
 
52
  
 
53
  close (CONFIGFILE);
 
54
}
 
55
 
 
56
 
 
57
for (my ($count)=0; $count<=$#serverlist; ++$count)
 
58
{
 
59
  $serverlist[$count] =~ s/\./\\./g;
 
60
}
 
61
 
 
62
 
 
63
if ($ENV{'DEBUG'})
 
64
{
 
65
  print "Players: ".join (', ', @playerlist)."\n";
 
66
  print "Servers: ".join (', ', @serverlist)."\n";
 
67
  print "Maps: ".join (', ', @maplist)."\n\n";
 
68
}
 
69
 
 
70
 
 
71
 
 
72
# Open up a connection to the metaserver; sort the servers listed there...
 
73
 
 
74
my ($iaddr, $paddr);
 
75
 
 
76
$iaddr = inet_aton ("meta.xpilot.org")  ||
 
77
  die "Unable to locate metaserver: $!\n";
 
78
 
 
79
$paddr = sockaddr_in (4401, $iaddr);
 
80
 
 
81
socket (METASERVER, PF_INET, SOCK_STREAM, getprotobyname ("tcp")) ||
 
82
  die "Unable to create socket: $!\n";
 
83
 
 
84
connect (METASERVER, $paddr) || 
 
85
  die ("Unable to connect to metaserver: $!\n");
 
86
 
 
87
while (<METASERVER>)
 
88
{
 
89
  chomp;
 
90
  
 
91
  my ($score, $count) = 0, 0;
 
92
 
 
93
  my ($version, $server, $port, $num_players, $map, $size, $written_by,
 
94
      $status, $max_players, $fps, $player_list, $sound, $uptime,
 
95
      $num_team_bases, $timing, $ipaddress, $num_free_bases,
 
96
      $num_queued_players) = split (':');
 
97
 
 
98
  next if $servers{"$server:$port"};
 
99
  $servers{"$server:$port"} = $_;
 
100
 
 
101
  for ($count=0; $count<=$#serverlist; ++$count)
 
102
  {
 
103
    ++$score if $server =~ /$serverlist[$count]/i;
 
104
    ++$score if $server =~ /\b$serverlist[$count]\b/i;
 
105
    ++$score if $server =~ /^$serverlist[$count]$/i;
 
106
  }
 
107
 
 
108
  for ($count=0; $count<=$#playerlist; ++$count)
 
109
  {
 
110
    ++$score if $player_list =~ /$playerlist[$count]/i;
 
111
    ++$score if $player_list =~ /\b$playerlist[$count]\b/i;
 
112
    ++$score if $player_list =~ /(^|,)$playerlist[$count]=/i;
 
113
  }
 
114
 
 
115
  for ($count=0; $count<=$#maplist; ++$count)
 
116
  {
 
117
    ++$score if $map =~ /$maplist[$count]/i;
 
118
    ++$score if $map =~ /\b$maplist[$count]\b/i;
 
119
    ++$score if $map =~ /^$maplist[$count]$/i;
 
120
  }
 
121
 
 
122
  ++$score if $player_list;
 
123
  $score-=9 if ($map =~ /(The (Newbie )?Globe|Random Land|CloudScape)/);
 
124
 
 
125
  printf "%-30s %d\n", $server, $score  if $ENV{'DEBUG'};
 
126
  
 
127
  $rank{$score} .= ($rank{$score} ? "," : "")."$server:$port";
 
128
}
 
129
 
 
130
close (METASERVER);
 
131
 
 
132
 
 
133
 
 
134
# Print out the servers ranked by score...
 
135
 
 
136
foreach $score (sort (keys (%rank)))
 
137
{
 
138
  next if $score < 1;
 
139
  foreach $server (split (',', $rank{$score}))
 
140
  {
 
141
    print_entry ($servers{$server});
 
142
  }
 
143
}
 
144
 
 
145
exit;
 
146
 
 
147
 
 
148
 
 
149
# Online help...
 
150
 
 
151
sub show_help
 
152
{
 
153
    print <<EOT;
 
154
Usage: $0 [OPTION]...
 
155
 
 
156
  -h, -\-help,               display this message
 
157
  -p, -\-player PLAYERLIST   watch out for player(s)
 
158
  -s, -\-server SERVERLIST   watch out for server(s)
 
159
  -m, -\-map MAPLIST         watch out for map(s)
 
160
 
 
161
EOT
 
162
}
 
163
 
 
164
 
 
165
# More online help (for people that can't get the options right)
 
166
 
 
167
sub parse_error
 
168
{
 
169
  my ($arg) = @_;
 
170
  print "$0: illegal option '$arg'\n";
 
171
  print "Try \'$0 --help\' for more information.\n";
 
172
}
 
173
 
 
174
 
 
175
# Display routine...
 
176
 
 
177
sub print_entry
 
178
{
 
179
  my ($line) = @_;
 
180
 
 
181
  my ($version, $server, $port, $num_players, $map, $size, $written_by,
 
182
      $status, $max_players, $fps, $player_list, $sound, $uptime,
 
183
      $num_team_bases, $timing, $ipaddress, $num_free_bases,
 
184
      $num_queued_players) = split (':', $line);  
 
185
 
 
186
  
 
187
  # Print the servername...
 
188
  
 
189
  printf "%-28s  %s\n",
 
190
    $server.($port == 15345 ? "" : ":$port"), 
 
191
    $map.($sound=~/yes/ ? " (sound)" : ""),
 
192
 
 
193
  
 
194
  # Print the players...
 
195
 
 
196
  my (@players) = split (",", $player_list);
 
197
 
 
198
  while (@players)
 
199
  {
 
200
    my ($name,$client) = split ("=", shift (@players));
 
201
 
 
202
    # Remove the team from the end of the client
 
203
    $client =~ s/\{([0-9]+)\}$//; 
 
204
    my ($team) = ($1 ? "Team $1" : "");
 
205
 
 
206
    # Remove spaces and trailing junk
 
207
    $client =~ s/[ ].*//;
 
208
 
 
209
    if ($team)
 
210
    {
 
211
      printf "  %-15s  %-7s  %s\n",
 
212
        $name,
 
213
        $team,
 
214
        $client;
 
215
    }
 
216
    else
 
217
    {
 
218
      printf "  %-15s  %s\n",
 
219
        $name,
 
220
        $client;
 
221
    }
 
222
   }
 
223
 
 
224
  print "\n";
 
225
}