ASR.pm

   1 package ASR::Ladder;
   2
   3 use strict;
   4 use warnings;
   5 use Time::Local;
   6 use Time::HiRes;
   7 use LWP::Simple;
   8 use POSIX qw/strftime/;
   9 use CGI;
  10 use DBI;
  11
  12 $ENV{HOME} = "/home/pasky/WWW/asr";
  13
  14 sub new {
  15         my $this = {};
  16         bless $this;
  17         $this->{startup} = Time::HiRes::time();
  18         $this->{dbreqs} = 0;
  19         $this->{cgi} = new CGI;
  20         $this->{scoring} = {
  21                 winportion => 3, # how big portion of score delta are win points
  22                 winfloor => 2, # minimal number of win points
  23                 dailydrop => 0.5, # daily global point drop
  24         };
  25         $this->get_dbi;
  26         return $this;
  27 }
  28
  29 sub get_dbi {
  30         return $_[0]->{dbi} if exists $_[0]->{dbi};
  31
  32         open MYCNF, "$ENV{HOME}/.my.cnf";
  33         local $/;
  34         my $contents = <MYCNF>;
  35         close MYCNF;
  36         my ($user, $database, $password);
  37         $user = $1 if $contents =~ /user = (.*)/;
  38         $database = $1 if $contents =~ /database = (.*)/;
  39         $password = $1 if $contents =~ /password = (.*)/;
  40         $_[0]->{adminpw} = $1 if $contents =~ /adminpw = (.*)/;
  41
  42         if (!$user || !$database || !$password || !$_[0]->{adminpw}) {
  43                 &die_clean_fatal("Sorry, the .my.cnf file appears to be corrupt");
  44         }
  45
  46         $_[0]->{dbi} = DBI->connect("dbi:mysql:database=$database", $user, $password);
  47         $_[0]->{password} = $password;
  48
  49         if (!$_[0]->{dbi}) {
  50                 $_[0]->die_fatal_db("Sorry, I can't seem to connect to the database.");
  51         }
  52
  53         return $_[0]->{dbi};
  54 }
  55
  56 sub die_fatal {
  57         $_[0]->header("Argh") unless $_[0]->{header};
  58         print $_[0]->h2("Fatal error: $_[1]");
  59         print $_[0]->h3("$_[2]");
  60         $_[0]->footer;
  61         exit;
  62 }
  63
  64 sub die_fatal_db {
  65         $_[0]->die_fatal($_[1], "Database says: ".DBI->errstr);
  66 }
  67
  68 sub die_fatal_permissions {
  69         $_[0]->die_fatal($_[1], "You don't have permission to do that!");
  70 }
  71
  72 sub die_fatal_badinput {
  73         $_[0]->die_fatal($_[1], "Your input incomplete/invalid.");
  74 }
  75
  76 sub header {
  77         my $this = $_[0];
  78         &die_clean_fatal("Header output twice?!") if $this->{header};
  79         $this->{header} = 1;
  80         my $cgi = new CGI;
  81         print $cgi->header;
  82         print $cgi->start_html(-title => "ASR Ladder", -style => "style.css");
  83         print $cgi->h1("ASR Ladder BETA");
  84
  85         #print qq<<p class=nav><a href="?mode=index$period">Summary</a> | <a href="?mode=stats$period">Stats</a> | <a href="?mode=brawl$period">Brawl</a> | <a href="?mode=votes">Votes</a></p>>;
  86
  87         $_[1] and print $cgi->h2($_[1]);
  88         $this->{cgi} = $cgi;
  89         return $cgi;
  90 }
  91
  92 sub action_fail {
  93         print $_[0]{cgi}->h2("Failed");
  94         print $_[0]{cgi}->p($_[1]);
  95 }
  96
  97 sub action_success {
  98         print $_[0]{cgi}->h2("Success");
  99         print $_[0]{cgi}->p($_[1]);
 100 }
 101
 102 sub footer {
 103         my $this = shift;
 104         my $cgi = $this->{cgi};
 105         my $time = Time::HiRes::time() - $this->{startup};
 106         #print $cgi->p("Request took $time secs, made $this->{dbreqs} queries.");
 107         print $cgi->end_html;
 108 }
 109
 110 sub db_do {
 111         my $this = shift @_;
 112         $this->{dbreqs}++;
 113         return $this->{dbi}->do(@_);
 114 }
 115
 116 sub db_select {
 117         my $this = shift @_;
 118         $this->{dbreqs}++;
 119         return $this->{dbi}->selectall_hashref(@_);
 120 }
 121
 122 sub db_selectrow {
 123         my $this = shift @_;
 124         $this->{dbreqs}++;
 125         return $this->{dbi}->selectrow_hashref(@_);
 126 }
 127
 128 sub db_selectone {
 129         my $this = shift @_;
 130         my $row = $this->{dbi}->selectrow_arrayref(@_);
 131         $this->{dbreqs}++;
 132         return undef unless $row;
 133         return $row->[0];
 134 }
 135
 136 sub lastid {
 137         my $this = shift @_;
 138         return $this->db_selectone("SELECT LAST_INSERT_ID();");
 139 }
 140
 141 sub baseurl {
 142         my $this = shift;
 143         my %vals = $this->{cgi}->Vars();
 144         delete $vals{$_} foreach (@_);
 145         if (keys %vals) {
 146                 return '?'.(join '&amp;', map { "$_=$vals{$_}" } keys %vals).'&amp;';
 147         } else {
 148                 return '?';
 149         }
 150 }
 151
 152 sub hidden {
 153         return qq|<input type="hidden" name="$_[1]" value="$_[2]"/>|;
 154 }
 155
 156 sub textarea {
 157         my $this = shift;
 158         return $this->{cgi}->textarea(@_);
 159 }
 160
 161 sub textfield {
 162         my $this = shift;
 163         return $this->{cgi}->textfield(@_);
 164 }
 165
 166 sub textfield_ {
 167         return qq|<input type="text" name="$_[1]" value="$_[2]" size="$_[3]" maxlength="$_[4]"/>|;
 168 }
 169
 170 sub passfield {
 171         my $this = shift;
 172         return $this->{cgi}->password_field(@_);
 173 }
 174
 175 sub param {
 176         my $this = shift;
 177         return $this->{cgi}->param(@_);
 178 }
 179
 180 sub h1 {
 181         my $this = shift;
 182         return $this->{cgi}->h1(@_);
 183 }
 184
 185 sub h2 {
 186         my $this = shift;
 187         return $this->{cgi}->h2(@_);
 188 }
 189
 190 sub h3 {
 191         my $this = shift;
 192         return $this->{cgi}->h3(@_);
 193 }
 194
 195 sub h4 {
 196         my $this = shift;
 197         return $this->{cgi}->h4(@_);
 198 }
 199
 200 sub p {
 201         my $this = shift;
 202         return $this->{cgi}->p(@_);
 203 }
 204
 205 sub submit {
 206         my $this = shift;
 207         return $this->{cgi}->submit(@_);
 208 }
 209
 210 sub end_form {
 211         my $this = shift;
 212         return $this->{cgi}->end_form(@_);
 213 }
 214
 215 sub escapeHTML {
 216         my $this = shift;
 217         return $this->{cgi}->escapeHTML(@_);
 218 }
 219
 220 sub begin_form {
 221         my $this = shift;
 222         if (shift eq 'get') {
 223                 print $this->{cgi}->start_form(-method => 'GET', -action => '?');
 224         } else {
 225                 print $this->{cgi}->start_form(-method => 'POST', -action => 'index.pl');
 226         }
 227         while (my $name = shift) {
 228                 my $val = shift;
 229                 print $this->hidden($name, $val);
 230         }
 231 }
 232
 233 sub list {
 234         my $this = shift;
 235         print "<ul>";
 236         print "<li>$_</li>" foreach(@_);
 237         print "</ul>"
 238 }
 239
 240 sub plink {
 241         my $this = shift;
 242         my ($id, $nick) = @_;
 243         return "<a href=\"player.pl?pid=$id\" class=\"playerlink\">$nick</a>";
 244 }
 245
 246 sub recompute_score {
 247         my $this = shift;
 248         my ($winner, $loser) = @_;
 249
 250         # Fine-tunable scoring constants
 251         my $gameval = 1; # points per completely even game
 252
 253         my $delta = 0.0 + $loser - $winner;
 254         my $extra = $delta / $this->{scoring}->{winportion};
 255         ($extra > $this->{scoring}->{winfloor}) or $extra = $this->{scoring}->{winfloor};
 256         return $winner + $extra;
 257 }