stats/foreverstats_wap.pl

   1 #!/usr/bin/perl
   2
   3 # foreverstats_wap.pl
   4 # NDC Code Release 1
   5 #
   6 # Connects to the database holding the stats, and builds a WAP-Page
   7 # from it.
   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
  28 #use strict;
  29 require 5.002;
  30 use DBI;
  31 use CGI;
  32
  33 my $CGIquery;
  34
  35 ### Var def ###
  36 $CGIquery = new CGI;
  37 $start = ($CGIquery->param("start")?$CGIquery->param("start"):0);
  38 $limit = ($CGIquery->param("limit")?$CGIquery->param("limit"):10);
  39
  40 # Rebuild database, if necessary
  41
  42 $database = "stats";
  43 $data_source = "DBI:mysql:$database";
  44 $username = "";
  45 $password = "";
  46 $dbh = DBI->connect( $data_source, $username, $password) or die "Can't connect to $data_source\n"; #: $dbh->errstr\n";
  47
  48 $query = $dbh->prepare("SELECT nick FROM PlayerStats WHERE fe_skill > 0");
  49 $query->execute;
  50 $rows = $query->rows;
  51 $query->finish;
  52
  53 $query = $dbh->prepare("SELECT nick ,skill FROM PlayerStats WHERE fe_skill > 0 ORDER by fe_skill DESC LIMIT $start,$limit");
  54 $query->execute;
  55
  56 while ($row_hash = $query->fetchrow_hashref) {
  57         $name = $row_hash->{nick};
  58         $nick{$name} = $name;
  59         $skill{$name} = $row_hash->{skill};
  60 }
  61 $query->finish;
  62 $dbh->disconnect;
  63
  64 # Sort
  65 @sortkey = sort { $skill{$b} <=> $skill{$a} } (keys %nick);
  66
  67 print "Content-Type: text/vnd.wap.wml\n\n\n";
  68
  69
  70
  71 ## Ausgabe ##
  72 ### Header ###
  73 print '<?xml version="1.0"?>' . "\n";
  74 print '<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml">' . "\n";
  75
  76 print "<wml>\n";
  77 print "<card id=\"card1\" title=\"Ewige Stats\">\n";
  78 if ($start!=0) {
  79   $start_prev=$start - 10;
  80   if ($start_prev<0) {$start_prev=0;}
  81   print "<do type=\"accept\" label=\"Zur&#252;ck\">\n";
  82   print "<go href=\"\/cgi-bin\/quake\/foreverstats_wap.pl\?start=$start_prev\"\/>\n";
  83   print "<\/do>\n";
  84 }
  85
  86 if (($start + 10) < $rows) {
  87   $start_next=$start + 10;
  88   print "<do type=\"accept\" label=\"Weiter\">\n";
  89   print "<go href=\"\/cgi-bin\/quake\/foreverstats_wap.pl\?start=$start_next\"\/>\n";
  90   print "<\/do>\n";
  91 }
  92
  93 print "<do type=\"accept\" label=\"Gestern\">\n";
  94 print "<go href=\"\/cgi-bin\/quake\/dailystats_wap.pl\"\/>\n";
  95 print "<\/do>\n";
  96
  97 print "<do type=\"accept\" label=\"Navigation\">\n";
  98 print "<go href=\"\/nav.wml\"\/>\n";
  99 print "<\/do>\n";
 100
 101 print "<do type=\"accept\" label=\"Hauptseite\">\n";
 102 print "<go href=\"\/\"\/>\n";
 103 print "<\/do>\n";
 104
 105 print "<p>\n";
 106
 107 print "<small>\n";
 108 print "<table columns=\"3\">\n";
 109 print "<tr><td>P.<\/td><td>Name<\/td><td>Skill<\/td><\/tr>\n";
 110
 111 $count = $start;
 112 foreach $name (@sortkey)
 113 {
 114        $count ++;
 115        print "<tr>\n";
 116        print "<td>$count<\/td>\n";
 117        print "<td>";
 118        print make_html($nick{$name});
 119        print "<\/td>\n";
 120        print "<td>$skill{$name}<\/td>\n";
 121        print "<\/tr>\n";
 122 }
 123
 124 print "<\/table></small>\n";
 125 print "<\/p>\n";
 126 print "<\/card>\n";
 127 print "<\/wml>";
 128
 129
 130 ############### Subroutines ###########
 131
 132 sub make_html {
 133
 134   $input = shift;
 135 #  $input =~ s/&/und/g;
 136   $input =~ s/</&lt\;/g;
 137   $input =~ s/>/&gt\;/g;
 138   $input =~ s/"/&quot\;/g;
 139 #  $input =~ s/\|/pipe/g;
 140   return $input;
 141 }
 142
 143 sub make_compatible {
 144
 145   $input = shift;
 146   $input =~ s/%/%25/g;
 147   $input =~ s/\+/%2B/g;
 148   $input =~ s/ /+/g;
 149   $input =~ s/,/%2C/g;
 150   $input =~ s/</%3C/g;
 151   $input =~ s/>/%3E/g;
 152   $input =~ s/#/%23/g;
 153   $input =~ s/\[/%5B/g;
 154   $input =~ s/\]/%5D/g;
 155   $input =~ s/\//%2F/g;
 156   $input =~ s/\|/%7C/g;
 157   $input =~ s/\?/%3F/g;
 158
 159   return $input;
 160 }