stats/dailystats_wap3.pl

   1 #!/usr/bin/perl
   2
   3 # dailystats_wap3.pl
   4 # NDC Code Release 1
   5 #
   6 # Connects to the server holding the stats, and builds a web page
   7 # of yesterdays players
   8 # CGI-Parameters:
   9 #       start:          First entry displayed
  10 #       limit:          Number of entries. Defaults to 10.
  11 #
  12 #   Copyright (C) 2001 Andreas Ulbrich, Ralf Ertzinger (ndccode@ndc.sh)
  13 #
  14 #   This program is free software; you can redistribute it and/or modify
  15 #   it under the terms of the GNU General Public License as published by
  16 #   the Free Software Foundation; either version 2 of the License, or
  17 #   (at your option) any later version.
  18 #
  19 #   This program is distributed in the hope that it will be useful,
  20 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 #   GNU General Public License for more details.
  23 #
  24 #   You should have received a copy of the GNU General Public License
  25 #   along with this program; if not, write to the Free Software
  26 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  27 #use strict;
  28 require 5.002;
  29 use DBI;
  30 use CGI;
  31
  32 my $CGIquery;
  33
  34 ### Var def ###
  35 $CGIquery = new CGI;
  36 $start = ($CGIquery->param("start")?$CGIquery->param("start"):0);
  37 $limit = ($CGIquery->param("limit")?$CGIquery->param("limit"):10);
  38
  39 # Rebuild database, if necessary
  40
  41 $database = "stats";
  42 $data_source = "DBI:mysql:$database";
  43 $username = "";
  44 $password = "";
  45 $dbh = DBI->connect( $data_source, $username, $password) or die "Can't connect to $data_source\n"; #: $dbh->errstr\n";
  46
  47 $query = $dbh->prepare("SELECT nick FROM PlayerStats WHERE mapsplayed > 0");
  48 $query->execute;
  49 $rows = $query->rows;
  50 $query->finish;
  51
  52 $query = $dbh->prepare("SELECT nick ,skill FROM PlayerStats WHERE mapsplayed > 0 ORDER by skill DESC LIMIT $start,$limit");
  53 $query->execute;
  54
  55 while ($row_hash = $query->fetchrow_hashref) {
  56         $name = $row_hash->{nick};
  57         $nick{$name} = $name;
  58         $skill{$name} = $row_hash->{skill};
  59 }
  60 $query->finish;
  61 $dbh->disconnect;
  62
  63 # Sort
  64 @sortkey = sort { $skill{$b} <=> $skill{$a} } (keys %nick);
  65
  66 print "Content-Type: text/vnd.wap.wml\n\n";
  67
  68 ## Ausgabe ##
  69 ### Header ###
  70 print '<?xml version="1.0"?>' . "\n";
  71 print '<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml">' . "\n\n";
  72
  73 print "<wml>\n";
  74 print "<card id=\"card1\" title=\"Gestern\">\n";
  75
  76 if (($start + 10) < $rows) {
  77   $start_next=$start + 10;
  78   print "<do type=\"accept\" label=\"Weiter\">\n";
  79   print "<go href=\"\/cgi-bin\/quake\/dailystats_wap.pl\?start=$start_next\"\/>\n";
  80   print "<\/do>\n";
  81 }
  82
  83 print "<p>\n";
  84
  85 print "<small>\n";
  86 print "<table columns=\"3\">\n";
  87 print "<tr><td>P.<\/td><td>Name<\/td><td>Skill<\/td><\/tr>\n";
  88
  89 $count = $start;
  90 foreach $name (@sortkey)
  91 {
  92        $count ++;
  93        print "<tr>\n";
  94        print "<td>$count<\/td>\n";
  95        print "<td>";
  96        print make_html($nick{$name});
  97        print "<\/td>\n";
  98        print "<td>$skill{$name}<\/td>\n";
  99        print "<\/tr>\n";
 100 }
 101
 102 print "<\/table></small>\n";
 103 print "<\/p>\n";
 104 print "</card>\n";
 105 print '</wml>';
 106
 107
 108 ############### Subroutines ###########
 109
 110 sub make_html {
 111
 112   $input = shift;
 113 #  $input =~ s/&/und/g;
 114   $input =~ s/</&lt\;/g;
 115   $input =~ s/>/&gt\;/g;
 116   $input =~ s/"/&quot\;/g;
 117 #  $input =~ s/\|/pipe/g;
 118   return $input;
 119 }
 120
 121 sub make_compatible {
 122
 123   $input = shift;
 124   $input =~ s/%/%25/g;
 125   $input =~ s/\+/%2B/g;
 126   $input =~ s/ /+/g;
 127   $input =~ s/,/%2C/g;
 128   $input =~ s/</%3C/g;
 129   $input =~ s/>/%3E/g;
 130   $input =~ s/#/%23/g;
 131   $input =~ s/\[/%5B/g;
 132   $input =~ s/\]/%5D/g;
 133   $input =~ s/\//%2F/g;
 134   $input =~ s/\|/%7C/g;
 135   $input =~ s/\?/%3F/g;
 136
 137   return $input;
 138 }