uzix/armastuff
1
0
Fork 0
mirror of https://github.com/UzixLS/armastuff.git synced 2025-07-18 23:01:34 +03:00
Code Issues Projects Releases Wiki Activity

added watch mode to armalist script

Browse Source
This commit is contained in:
Eugene Uzix
2012-08-22 19:37:19 +04:00
parent f895b604c2
commit 3b2ced74c7
1 changed files with 224 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

284
armalist/armalist.pl
View File

@ -1,101 +1,265 @@
#!/usr/bin/env perl
# Armagetron server list v0.2
# Armagetron server list v0.3
# Eugene Uzix <uzix.ls@gmail.com>
use 5.010;
use strict;
use POSIX qw(strftime);
use Getopt::Long;
use WWW::Curl::Easy;
use XML::Simple;
use Encode;
use Data::Dumper;
my $curl = WWW::Curl::Easy->new;
my $response_body;
my $retcode;
my %servers;
my $html = 0;
my $debug = 0;
my $noempty = 0;
my $watch = 0;
my $html = 0;
my $url = 'http://simamo.de/~manuel/arma-serverlist.js/serverxml.php';
my $file = 'serverxml.php';
my $logfile = 'armalist.log';
GetOptions ("html" => \$html, "noempty" => \$noempty);
GetOptions (
"debug" => \$debug,
"noempty" => \$noempty,
"watch" => \$watch,
"html" => \$html,
"url" => \$url,
"file" => \$file,
"logfile=s" => \$logfile,
);
sub process {
my $temp = join ' ', @_;
Encode::from_to($temp, 'ISO_8859-1', 'UTF-8');
$temp =~ s/0x......//g;
$temp =~ s/^\ *//g;
sub process
{
my $string = join ' ', @_;
Encode::from_to($string, 'ISO_8859-1', 'UTF-8');
$string =~ s/0x......//g;
$string =~ s/^\ *//g;
if ($html) {
$temp =~ s/</&lt;/g;
$temp =~ s/>/&gt;/g;
$string =~ s/</&lt;/g;
$string =~ s/>/&gt;/g;
}
return $temp;
return $string;
}
$curl->setopt(CURLOPT_HEADER, 0);
$curl->setopt(CURLOPT_URL, 'http://simamo.de/~manuel/arma-serverlist.js/serverxml.php');
$curl->setopt(CURLOPT_WRITEDATA, \$response_body);
sub read_inet
{
my ($inurl, $outfile) = @_;
my $curl = WWW::Curl::Easy->new;
my $response_body;
my $retcode;
$retcode = $curl->perform;
if ($retcode != 0) {
die ("An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n");
}
my $serverlist = XMLin($response_body);
for my $i (keys $serverlist->{'Server'}) {
my $sname = &process($i);
while (defined($servers{$sname})) { $sname = $sname . "_"; }
if (defined $serverlist->{'Server'}->{$i}->{'Player'}) {
for my $ii (keys $serverlist->{'Server'}->{$i}->{'Player'}) {
if (ref($serverlist->{'Server'}->{$i}->{'Player'}->{$ii}) eq "HASH" &&
defined $serverlist->{'Server'}->{$i}->{'Player'}->{$ii}->{'global_id'}) {
push @{$servers{$sname}{players}},
$serverlist->{'Server'}->{$i}->{'Player'}->{$ii}->{'global_id'};
} else {
push @{$servers{$sname}{players}}, &process($ii);
}
}
} else {
if ($noempty) { next; }
else { @{$servers{$sname}{players}} = (); }
}
print "Fetching $inurl...\n" if $debug;
$curl->setopt(CURLOPT_HEADER, 0);
$curl->setopt(CURLOPT_URL, $inurl);
$curl->setopt(CURLOPT_WRITEDATA, \$response_body);
$servers{$sname}{addr} = $serverlist->{'Server'}->{$i}->{'ip'}.
':'.$serverlist->{'Server'}->{$i}->{'port'};
$servers{$sname}{descr} = &process($serverlist->{'Server'}->{$i}->{'description'});
$servers{$sname}{url} = &process($serverlist->{'Server'}->{$i}->{'url'});
$servers{$sname}{ver} = $serverlist->{'Server'}->{$i}->{'version'};
$servers{$sname}{maxpl} = $serverlist->{'Server'}->{$i}->{'maxplayers'};
$servers{$sname}{numpl} = $serverlist->{'Server'}->{$i}->{'numplayers'};
unless ($servers{$sname}{url} =~ /^http:/) { $servers{$sname}{url} =~ s/(.*)/http:\/\/\1/; }
$retcode = $curl->perform;
if ($retcode != 0) {
die ("An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n");
}
print "...done\n" if $debug;
if ($outfile) {
print "Writting file $outfile\n" if $debug;
open my $out, '>', $outfile or die "Cannot open file $outfile: $!\n";
print $out $response_body;
close $out;
}
return XMLin($response_body, ForceArray => 1, parseropts => [ load_ext_dtd => 0 ])
}
if ($html) {
sub read_file
{
my $in = shift;
print "Reading file $in\n" if $debug;
return XMLin($in, ForceArray => 1, parseropts => [ load_ext_dtd => 0 ]);
}
sub bold
{
if ($html) {
return "<b>@_</b>";
} else {
return "@_";
}
}
sub endl
{
if ($html) {
return "<br>";
} else {
return "\n";
}
}
sub print_html_header
{
print '
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Armagetron server list</title>
<title>Armagetron server list script</title>
<meta http-equiv="content-type" content="text/html;charset=utf-8" />
<link rel="stylesheet" type="text/css" href="serverlist.css" />
</head>
<body>
';
}
sub print_html_footer
{
print '
</body>
</html>
';
}
sub print_html
{
my $servers = shift;
&print_html_header;
print '
<table><tr>
<th>Server Name</th>
<th>Address</th>
<th>Players</th>
</tr>';
for my $i (sort {"\L$a" cmp "\L$b"} keys %servers) {
for my $i (sort {"\L$a" cmp "\L$b"} keys %{$servers}) {
print "
<tr>
<td><a href='$servers{$i}{url}'>$i</a></td>
<td>$servers{$i}{addr}</td>
<td>". join (', ', @{$servers{$i}{players}}) ."</td>
<td><a href='$servers->{$i}{url}'>$i</a></td>
<td>$servers->{$i}{addr}</td>
<td>". join (', ', @{$servers->{$i}{players}}) ."</td>
</tr>\n";
}
print '</table></body></html>';
print '</table>';
&print_html_footer;
}
else {
for my $i (sort {"\L$a" cmp "\L$b"} keys %servers) {
print "$i ### $servers{$i}{addr} ### ". join (', ', @{$servers{$i}{players}}) ."\n";
sub print_plain
{
my $servers = shift;
for my $i (sort {"\L$a" cmp "\L$b"} keys %{$servers}) {
print "$i ### $servers->{$i}{addr} ### ". join (', ', @{$servers->{$i}{players}}) ."\n";
}
}
sub compare_log
{
my ($old, $new, $outfile) = @_;
my $time = strftime "%Y/%m/%d %H:%M", gmtime;
if ($html) {
$time = "<i>$time</i>";
}
print "Comparing server lists\n" if $debug;
print "Open file $outfile\n" if $debug;
open my $out, '>', $outfile or die "Cannot open file $outfile: $!\n";
if (! keys %{$new}) {
print $out "$time: error upgrading server list.".&endl;
die "$time: error upgrading server list.";
}
if (! keys %{$old}) {
print "No old data found\n" if $debug;
print $out "$time: start watching.".&endl;
}
my @whoremoved = grep { ! ($_ ~~ @{[keys %{$new}]}) } keys %{$old};
print $out "$time: server ".&bold($_)." offline".&endl for sort @whoremoved;
my @whoadded = grep { ! ($_ ~~ @{[keys %{$old}]}) } keys %{$new};
print $out "$time: server ".&bold($_)." on ".&bold($new->{$_}{addr})." online".&endl for sort (@whoadded);
for my $sname (keys %{$new}) {
if (defined $old->{$sname}) {
for (qw/addr descr url ver maxpl/) {
if (! ($old->{$sname}{$_} ~~ $new->{$sname}{$_})) {
print $out "$time: server ".&bold($sname)." changed ".&bold($_)." from ".&bold($old->{$sname}{$_})." to ".&bold($new->{$sname}{$_}).&endl;
}
}
}
}
my %playerlist;
for my $s ($old, $new) {
for my $sname (sort keys %{$s}) {
for my $pname (@{$s->{$sname}{players}}) {
if ($pname ~~ %playerlist && defined $playerlist{$pname}{$s}) {
print $out "$time: clones for ".&bold($pname)." detected on ".&bold($playerlist{$pname}{$s})." and ".&bold($sname).&endl if ($s == $new);
$pname .= '_' while (defined $playerlist{$pname}{$s});
}
$playerlist{$pname}{$s} = $sname;
}
}
}
for my $pname (keys %playerlist) {
if (! defined $playerlist{$pname}{$old}) {
print $out "$time: Player ".&bold($pname)." joined to server".&bold($playerlist{$pname}{$new}).&endl;
} elsif (! defined $playerlist{$pname}{$new}) {
print $out "$time: Player ".&bold($pname)." left from server ".&bold($playerlist{$pname}{$old}).&endl;
} elsif (! ($playerlist{$pname}{$old} ~~ $playerlist{$pname}{$new})) {
print $out "$time: Player ".&bold($pname)." moved from server ".&bold($playerlist{$pname}{$old})." to server ".&bold($playerlist{$pname}{$new}).&endl;
}
}
print "Comparing complete\n" if $debug;
close $out;
}
sub fill_serverhash
{
my $serverlist = shift;
my %servers;
for my $i (keys $serverlist->{'Server'}) {
my $sname = &process($i);
while (defined($servers{$sname})) { $sname = $sname . "_"; }
if (defined $serverlist->{'Server'}->{$i}->{'Player'}) {
for my $ii (keys $serverlist->{'Server'}->{$i}->{'Player'}) {
if (ref($serverlist->{'Server'}->{$i}->{'Player'}->{$ii}) eq "HASH" &&
defined $serverlist->{'Server'}->{$i}->{'Player'}->{$ii}->{'global_id'}) {
push @{$servers{$sname}{players}},
"$ii ($serverlist->{'Server'}->{$i}->{'Player'}->{$ii}->{'global_id'})";
} else {
push @{$servers{$sname}{players}}, &process($ii);
}
}
} else {
if ($noempty) { next; }
else { @{$servers{$sname}{players}} = (); }
}
$servers{$sname}{addr} = $serverlist->{'Server'}->{$i}->{'ip'}.
':'.$serverlist->{'Server'}->{$i}->{'port'};
$servers{$sname}{descr} = &process($serverlist->{'Server'}->{$i}->{'description'});
$servers{$sname}{url} = &process($serverlist->{'Server'}->{$i}->{'url'});
$servers{$sname}{ver} = $serverlist->{'Server'}->{$i}->{'version'};
$servers{$sname}{maxpl} = $serverlist->{'Server'}->{$i}->{'maxplayers'};
$servers{$sname}{numpl} = $serverlist->{'Server'}->{$i}->{'numplayers'};
unless ($servers{$sname}{url} =~ /^http:/) { $servers{$sname}{url} =~ s/(.*)/http:\/\/\1/; }
}
return %servers;
}
print "Starting " if $debug;
if ($watch) {
print "watcher\n" if $debug;
my %savedservers = &fill_serverhash (&read_file ($file)) if (-r $file);
#my %activservers = &fill_serverhash (&read_inet ($url, $file));
my %activservers = &fill_serverhash (&read_file ("AAA.xml"));
&compare_log (\%savedservers, \%activservers, $logfile);
} else {
print "lister\n" if $debug;
#my %activservers = &fill_serverhash (&read_inet ($url));
my %activservers = &fill_serverhash (&read_file ("AAA.xml"));
$html && &print_html(\%activservers) || &print_plain(\%activservers);
}
print "Stopping.\n" if $debug;