Hmm jeg har et script i perl som jeg virkelig skal bruge
men jeg har ikke suport for perl og jeg fatter intet af det! men dette script ligner medet php! så jeg vil spøre om der er et venligt sjæl som kan "oversættet" det til php for mig?
// here it se!
# webqstat.cgi by David Efflandt (efflandt@xnet.com)
# 10/10/97 - Last modified 1/28/99
#
# Displays status of a QuakeWorld or Q2 server in HTML table format.
# Includes team totals and players sorted by frags.
# Should work with any browser that supports tables (no plugin req'd).
# It even displays in lynx. Suitable for use as server side include.
# Script tested on Linux and Solaris.
#
# Requires qstat 2.0b or newer by Steve Jankowski (steve@activesw.com)
# available as UNIX source and compiled Win32 versions.
#
http://www.activesw.com/people/steve/qstat.html#
ftp://ftp.activesw.com/pub/quake### User Variables ###
# Comment out following line if it displays in an SSI
print "Content-type: text/html\\n\\n";
# Example to work with different paths depending upon hostname
$hostname = `hostname`;
if ($hostname =~ /efflandt/) {
$qstat = '/usr/local/games/quake2/qstat';
} else {
$qstat = '/home/hurricane/efflandt/src/qstat/qstat';
}
# Or comment out the above and use actual path to your qstat:
# $qstat = '/full_path_to/qstat';
# Your town or nearest major city (for time zone)
$city = 'Chicago';
# Display rules? 0 = no, 1 = yes
$rules = 1;
# For standalone CGI, a non-default server can be poled by following
# URL of script with either "?" or "/" and then "server[:port]".
# "server" can be IP or hostname.
#
# Example: webqstat.cgi?198.147.221.120:27910
#
# For SSI the following could be edited to add servers by linking
# this script to alternative names with dash and option and parsing
# the name for options. For example webqstat.cgi for one server and
# webqstat-dm.cgi for another.
# Get arguments from program name.
$arg = $0;
$arg =~ s/(\\.cgi|\\.pl)//; #strip .cgi|.pl name extension
$arg =~ s!^(.*-)!!; # chop program name
# Other possible sources of options
$arg = $ARGV[0] if $ARGV[0];
$arg = $ENV{'PATH_INFO'} if $ENV{'PATH_INFO'};
$arg =~ s!/!!; # strip leading / from path info
$arg = $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'};
# Hostname or IP address of server.
# :port required if not QW default (:27500)
if ($arg =~ /^\\w+[\\.\\:]+/) { # specific server[:port]
$arg =~ /([\\w\\.\\:]+)/;
$server = $1
} elsif ($arg eq 'dm') { # sample option
$server = '198.147.221.120'; # QW
} else { # default
$server = '198.147.221.120:27910'; # Q2
}
# Edit switches only for non-QW/Q2 server
$buffer = `$qstat -R -P -cn -raw "|,|" -qws $server`;
### Uncomment to test table vs. raw & formatted data
# print "<PRE>$buffer</PRE><P>\\n";
# $test = `$qstat -P -qws $server`;
# print "<PRE>$test</PRE><P>\\n";
### End of User Variables ###
# Browser safe colors
%rgb = (
White => 'FFFFFF',
Brown => 'CC9966',
Lavender => '9966FF',
Khaki => 'CCCC99',
Red => 'FF0000',
'Lt Brown' => 'FFCC99',
Peach => 'FFCC00',
'Lt Peach' => 'FFCCCC',
Purple => 'CC66FF',
'Dk Purple' => 'FF99FF',
Tan => 'FFFFCC',
Green => '00CC99',
Yellow => 'FFFF00',
Blue => '0000FF'
);
# Begin html table with main server data
@lines = split("\\n", $buffer);
$_ = shift @lines;
($type,$addr,$server,$map,$max,$players,$response,$retry) =
split /\\|,\\|/, $_;
$now = scalar localtime();
$response .= "ms";
$map = "none" unless $map;
# Get rules
$rulelist = shift @lines;
if ($type eq "Q2") {
@rules = split /\\|,\\|/, $rulelist;
while ($_ = shift @rules) {
($key, $value) = split /=/, $_;
if ($key =~ /version/i) { $qver = "$value<BR>\\n"; }
}
}
print <<EOF;
<P><CENTER><TABLE BORDER=1 CELLPADDING=3 CELLSPACING=2>
<TR><TH COLSPAN=5 BGCOLOR="#000000"><FONT COLOR="#ffffff">$server
<BR>$qver$city Time: $now</FONT></TH></TR>
<TR><TH>ADDRESS<TH>PLAYERS<TH>MAP<TH COLSPAN=2>RESPONSE
<TR ALIGN=CENTER><TD>$addr<TD>$players / $max
<TD>$map<TD COLSPAN=2>$response / $retry</TD></TR>
EOF
# Organize player data if any
if (@lines) {
while ($_ = shift @lines) {
if ($type eq "Q2") {
($name,$frags,$ping) = split /\\|,\\|/, $_;
} else {
($id,$name,$frags,$time,$shirt,$pants,$ping,$skin) =
split /\\|,\\|/, $_;
}
$name =~ s/[<]/<\\;/g;
$name =~ s/[>]/>\\;/g;
$name = "noname$nn++" unless $name =~ /[\\w]/;
push @namelist, $name;
$frags{$pants} += $frags;
if ($ping < 2000) {
$ping{$pants} += $ping;
$pingn{$pants}++;
}
$count{$pants}++;
++$i;
%new_folks = (
frags => $frags,
time => $time,
shirt => $shirt,
pants => $pants,
ping => $ping,
skin => $skin
);
for $what (keys %new_folks) {
$player{$name}{$what} = $new_folks{$what};
}
}
# Display team totals if more than one player per team
$teams = keys %count;
if ($rule{teamplay} && $players > $teams) {
print "<TR><TD COLSPAN=5>\\n";
print "<TR><TH>TEAMS<TH>FRAGS<TH>AVE PING<TH COLSPAN=2>COLOR\\n";
sub frags {$frags{$b} <=> $frags{$a};}
foreach $team (sort frags keys %count) {
$ping = int $ping{$team}/$pingn{$team};
$ping .= "ms ave";
print qq(<TR ALIGN=CENTER><TD><FONT COLOR="\\#$rgb{$team}">
;
print qq($count{$team} PLAYERS<TD>$frags{$team}\\n);
print qq(<TD>$ping<TD COLSPAN=2 BGCOLOR="\\#$rgb{$team}">
;
print qq(<FONT COLOR="\\#$rgb{$team}">$team</FONT>\\n);
}
}
# Display players if any
print "<TR><TD COLSPAN=5>\\n";
if ($type eq "Q2") {
print "<TR><TH COLSPAN=2>NAME<TH>FRAGS<TH COLSPAN=2>PING\\n";
} else {
print "<TR><TH>NAME<TH>FRAGS<TH>TIME";
print "<TH>SKIN<TH>COLOR\\n";
}
sub byfrag {$player{$b}{frags} <=> $player{$a}{frags};}
foreach $name (sort byfrag @namelist) {
$frags = $player{$name}{frags};
$time = $player{$name}{time};
if ($time) {
$time = $time/60 . "m\\@";
} else {
$time = "";
}
$shirt = $player{$name}{shirt};
$shirtrgb = $rgb{$shirt};
$pants = $player{$name}{pants};
$pantsrgb = $rgb{$pants};
$ping = $player{$name}{ping};
if ($ping > 0) {
$ping .= "ms";
} else {
$ping = "cl_nodelta";
}
$skin = $player{$name}{skin};
$skin = "?" unless $skin;
if ($type eq "Q2") {
print "<TR ALIGN=CENTER><TD COLSPAN=2>$name<TD>$frags"
. "<TD COLSPAN=2>$ping\\n";
} else {
print "<TR ALIGN=CENTER><TD ROWSPAN=2>$name<TD ROWSPAN=2>$frags"
. "<TD ROWSPAN=2>$time$ping<TD ROWSPAN=2>$skin";
print qq(<TD BGCOLOR="\\#$shirtrgb">
;
print qq(<FONT SIZE=1 COLOR="\\#$shirtrgb">$shirt</FONT>
;
print qq(<TR ALIGN=CENTER><TD BGCOLOR="\\#$pantsrgb">
;
print qq(<FONT SIZE=1 COLOR="\\#$pantsrgb">$pants</FONT></TD>\\n);
}
}
}
print "</TABLE></CENTER><P>\\n";
# Display rule table (optional, see Variables above)
if ($rules) {
print "<p><center><TABLE BORDER=0 CELLPADDING=3 CELLSPACING=2>";
print "<tr><td> </td></tr></table></center>\\n";
print "<P><CENTER><TABLE BORDER=1 CELLPADDING=3 CELLSPACING=2>";
print qq(<TR><TH COLSPAN=2 BGCOLOR="#000000">
<FONT COLOR="#ffffff">$server</FONT>\\n);
print "<TR><TH>RULE<TH>VALUE\\n";
@rules = split /\\|,\\|/, $rulelist;
while ($_ = shift @rules) {
($key, $value) = split /=/, $_;
print "<TR><TD ALIGN=CENTER>$key<TD>$value\\n";
}
print "</TABLE></CENTER><P>\\n";
}
----------------------
DoomStone@DoomStone.dk