a script to login to the multiplayer server and display/log the chat
This commit is contained in:
parent
17d24aa380
commit
3f4be3cad5
1 changed files with 136 additions and 0 deletions
136
utils/mp-lobby-logger.pl
Executable file
136
utils/mp-lobby-logger.pl
Executable file
|
@ -0,0 +1,136 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use wml_net;
|
||||
use POSIX qw(strftime);
|
||||
use Data::Dumper;
|
||||
|
||||
my $usage = '$0 username [server] [port]';
|
||||
if (@ARGV > 3 or @ARGV == 0) {die "Usage: $usage\n";}
|
||||
|
||||
my $USERNAME = $ARGV[0];
|
||||
my $HOST = 'server.wesnoth.org';
|
||||
my $PORT = '15000';
|
||||
if ($ARGV[1]) {$HOST = $ARGV[1];}
|
||||
if ($ARGV[2]) {$PORT = $ARGV[2];}
|
||||
my $LOGIN_RESPONSE = "[login]\nusername=\"$USERNAME\"\n[/login]";
|
||||
my $VERSION_RESPONSE = "[version]\nversion=\"test\"\n[/version]";
|
||||
my @usernamelist = ();
|
||||
|
||||
|
||||
print STDERR "Connecting to $HOST:$PORT as $USERNAME.\n";
|
||||
my $socket = eval {&wml_net::connect($HOST,$PORT)};
|
||||
$@ eq '' or die "Error: $@";
|
||||
defined($socket) or die "Error: Can't connect to the server.";
|
||||
|
||||
|
||||
sub read_server_response {
|
||||
my $response = eval {
|
||||
&wml_net::read_packet($socket)
|
||||
};
|
||||
$@ eq '' or die "Error: $@";
|
||||
#print STDERR Dumper($response);
|
||||
return $response;
|
||||
}
|
||||
|
||||
sub write_to_server {
|
||||
my $message = shift;
|
||||
#print STDERR $message;
|
||||
eval {
|
||||
&wml_net::write_packet($socket,&wml::read_text($message))
|
||||
};
|
||||
$@ eq '' or die "Error: $@";
|
||||
}
|
||||
|
||||
sub login {
|
||||
my $response = read_server_response();
|
||||
# server asks for the version string or tells us to login right away
|
||||
if ($response->{'children'}[0]->{'name'} eq 'version') {
|
||||
write_to_server($VERSION_RESPONSE);
|
||||
$response = read_server_response();
|
||||
# server asks for a login
|
||||
if ($response->{'children'}[0]->{'name'} eq 'mustlogin') {
|
||||
write_to_server($LOGIN_RESPONSE);
|
||||
} elsif ($response->{'children'}[0]->{'name'} eq 'error') {
|
||||
print STDERR "Error: $response->{'children'}[0]->{'attr'}->{'message'}.\n" and die;
|
||||
} else {
|
||||
print STDERR "Error: Server didn't ask us to log in and gave no error.\nDumper($response)" and die;
|
||||
}
|
||||
} elsif ($response->{'children'}[0]->{'name'} eq 'error') {
|
||||
print STDERR "Error: $response->{'children'}[0]->{'attr'}->{'message'}.\n" and die;
|
||||
} elsif ($response->{'children'}[0]->{'name'} eq 'mustlogin') {
|
||||
write_to_server($LOGIN_RESPONSE);
|
||||
} else {
|
||||
print STDERR "Error: Server didn't ask for version or login and gave no error.\nDumper($response)" and die;
|
||||
}
|
||||
|
||||
# server sends the join lobby response
|
||||
$response = read_server_response();
|
||||
if ($response->{'children'}[0]->{'name'} eq 'join_lobby') {
|
||||
} elsif ($response->{'children'}[0]->{'name'} eq 'error') {
|
||||
print STDERR "Error: $response->{'children'}[0]->{'attr'}->{'message'}.\n" and die;
|
||||
} else {
|
||||
print STDERR "Error: Server didn't ask us to join the lobby and gave no error.\nDumper($response)" and die;
|
||||
}
|
||||
|
||||
# server sends the initial list of games and players
|
||||
$response = read_server_response();
|
||||
#print STDERR Dumper($response);
|
||||
if ($response->{'children'}[0]->{'name'} eq 'gamelist') {
|
||||
foreach (@ {$response->{'children'}}) {
|
||||
if ($_->{'name'} eq 'user') {
|
||||
$usernamelist[@usernamelist] = $_->{'attr'}->{'name'};
|
||||
}
|
||||
}
|
||||
} elsif ($response->{'children'}[0]->{'name'} eq 'error') {
|
||||
print STDERR "Error: $response->{'children'}[0]->{'attr'}->{'message'}.\n" and die;
|
||||
} else {
|
||||
print STDERR "Error: Server didn't send the initial gamelist and gave no error.\nDumper($response)" and die;
|
||||
}
|
||||
print STDERR "usernames: @usernamelist\n";
|
||||
}
|
||||
|
||||
login();
|
||||
|
||||
while (1) {
|
||||
my $response = read_server_response();
|
||||
# print only chat messages
|
||||
foreach (@ {$response->{'children'}}) {
|
||||
if ($_->{'name'} eq 'message') {
|
||||
print STDERR strftime "%Y%m%d %T ", localtime();
|
||||
# /me actions
|
||||
if ($_->{'attr'}->{'message'} =~ s,^/me,,) {
|
||||
print STDERR "* " . $_->{'attr'}->{'sender'} . "" . $_->{'attr'}->{'message'} . "\n";
|
||||
} else {
|
||||
print STDERR "<" . $_->{'attr'}->{'sender'} . "> " . $_->{'attr'}->{'message'} . "\n";
|
||||
}
|
||||
} elsif ($_->{'name'} eq 'whisper') {
|
||||
print STDERR strftime "%Y%m%d %T ", localtime();
|
||||
print STDERR "*" . $_->{'attr'}->{'sender'} . "* " . $_->{'attr'}->{'message'} . "\n";
|
||||
} elsif ($_->{'name'} eq 'gamelist_diff') {
|
||||
foreach (@ {$_->{'children'}}) {
|
||||
if ($_->{'name'} eq 'insert_child') {
|
||||
if ($_->{'children'}[0]->{'name'} eq 'user') {
|
||||
print STDERR strftime "%Y%m%d %T ", localtime();
|
||||
print STDERR "--> $_->{'children'}[0]->{'attr'}->{'name'} has logged on. ($_->{'attr'}->{'index'})\n";
|
||||
$usernamelist[@usernamelist] = $_->{'children'}[0]->{'attr'}->{'name'};
|
||||
#print STDERR "usernames: @usernamelist\n";
|
||||
}
|
||||
#print STDERR Dumper($_);
|
||||
} elsif ($_->{'name'} eq 'delete_child' and $_->{'children'}[0]->{'name'} eq 'user') {
|
||||
print STDERR strftime "%Y%m%d %T ", localtime();
|
||||
my $index = $_->{'attr'}->{'index'};
|
||||
print STDERR "<-- $usernamelist[$index] has logged off. ($index)\n";
|
||||
splice(@usernamelist,$index,1);
|
||||
#print STDERR "usernames: @usernamelist\n";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
#print STDERR Dumper($_);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
#print STDERR "Connection closed.\n\n"
|
||||
|
Loading…
Add table
Reference in a new issue