Fix bug allowing any password and add Line.pm and Points.pm

diff --git a/lib/Duplo/Line.pm b/lib/Duplo/Line.pm
new file mode 100644 (file)
index 0000000..3c11b38
--- /dev/null
+++ b/lib/Duplo/Line.pm
@@ -0,0 +1,37 @@
+package Duplo::Line;
+use Mojo::Base 'Mojolicious::Controller';
+
+sub new_line {
+       my $self     = shift;
+       my $dbh      = $self->db();
+       my $stage    = $self->param('stage');
+       my $type     = $self->param('type');
+       my $name     = $self->param('name');
+
+       $dbh->do("
+               INSERT INTO
+                 line (stage, type, name)
+               VALUES (?, ?, ?)
+               ", undef, $stage, $type, $name);
+
+       return $self->redirect_to('stage', stage => $stage);
+}
+
+sub rider {
+       my $self   = shift;
+       my $dbh    = $self->db();
+       my $line   = $self->param('line');
+       my $rider  = $self->param('rider');
+       my $number = $self->param('number');
+
+       $dbh->do("
+               INSERT INTO
+                 rider_line (line, rider, \"number\")
+               VALUES (?, ?, ?)
+               ", undef, $line, $rider, $number);
+
+       return $self->render(text => 'SUCCESS');
+}
+
+1;
+

diff --git a/lib/Duplo/Points.pm b/lib/Duplo/Points.pm
new file mode 100644 (file)
index 0000000..97a41ed
--- /dev/null
+++ b/lib/Duplo/Points.pm
@@ -0,0 +1,241 @@
+package Duplo::Points;
+use Mojo::Base 'Mojolicious::Controller';
+use Data::Dumper;
+
+our %POINTS = (
+       'FINISH' => {
+               1 => 90,
+               2 => 80,
+               3 => 60,
+               4 => 50,
+               5 => 40,
+               6 => 36,
+               7 => 32,
+               8 => 28,
+               9 => 24,
+               10 => 21,
+               11 => 18,
+               12 => 15,
+               13 => 12,
+               14 => 10,
+               15 => 8,
+               16 => 7,
+               17 => 6,
+               18 => 5,
+               19 => 4,
+       },
+       'SPRINT' => {
+               1 => 20,
+               2 => 17,
+               3 => 15,
+               4 => 13,
+               5 => 11,
+               6 => 10,
+               7 => 9,
+               8 => 8,
+               9 => 7,
+               10 => 6,
+               11 => 5,
+               12 => 4,
+               13 => 3,
+               14 => 2,
+               15 => 1,
+       },
+       'TTT' => {
+               1 => 150,
+               2 => 120,
+               3 => 96,
+               4 => 72,
+               5 => 60,
+               6 => 48,
+               7 => 42,
+               8 => 36,
+               9 => 30,
+               10 => 24,
+               11 => 18,
+               12 => 18,
+               13 => 18,
+               14 => 18,
+               15 => 18,
+               16 => 12,
+               17 => 12,
+               18 => 12,
+               19 => 12,
+               20 => 12,
+               21 => 6,
+               22 => 6,
+       },
+);
+
+our %MOUNTAIN = (
+       '0' => {
+               1 => 60,
+               2 => 48,
+               3 => 36,
+               4 => 24,
+               5 => 12,
+               6 => 6,
+       },
+       '1' => {
+               1 => 30,
+               2 => 24,
+               3 => 18,
+               4 => 12,
+               5 => 6,
+               6 => 3,
+       },
+       '2' => {
+               1 => 15,
+               2 => 9,
+               3 => 6,
+               4 => 3,
+       },
+       '3' => {
+               1 => 6,
+               2 => 3,
+       },
+       '4' => {
+               1 => 3,
+       },
+);
+
+our %MULT = (
+       'SPRINTER' => 2,
+       'CAPTAIN'  => 2,
+       'CLIMBER'  => 3,
+       'TT'       => 3,
+       'WATER'    => 4,
+);
+
+sub get_points {
+       my $self = shift;
+       my $r = shift;
+       my $w = shift;
+       my $t = $r->{'line_type'};
+
+       my $p = 0;
+
+       # Mountains has categories
+       if ($t eq 'MOUNTAIN') {
+               $p += $POINTS{$t}->{$r->{'category'}}->{$r->{'number'}};
+       }
+       # Finishes has ranges (could make a huge hash with >100 entries too
+       elsif ($t eq 'FINISH') {
+               # 20 - 49
+               if ($r->{'number'} >= 20 and $r->{'number'} <= 49) {
+                       $p += 3;
+               }
+               # 50 - 99
+               elsif ($r->{'number'} >= 50 and $r->{'number'} <= 99) {
+                       $p += 2;
+               }
+               # 100 -
+               elsif ($r->{'number'} >= 100) {
+                       $p += 1;
+               }
+               # The rest are in the hash POINTS
+               else {
+                       $p += $POINTS{$t}->{$r->{'number'}};
+               }
+       } else {
+               $p += $POINTS{$t}->{$r->{'number'}};
+       }
+
+       # 10 points for everyone on the team
+       if ($t eq 'FINISH' and $r->{'team'} eq $w) {
+               $p += 10;
+       }
+
+       return $p * $MULT{$r->{'rider_type'}};
+}
+
+sub calculate {
+       my $self  = shift;
+       my $dbh   = $self->db();
+       my $stage = $self->param('stage');
+       my $after_restday = defined $self->param('after_restday') ? 1 : 0;
+
+       $dbh->do("
+               UPDATE
+                 rider_stage
+               SET
+                 points = 0
+               WHERE
+                 stage = ?
+               ", undef, $stage);
+
+       my ($winner_team) = $dbh->selectrow_array("
+               SELECT
+                 team
+               FROM
+                 rider_line AS rl
+               JOIN
+                 line AS l
+               ON (rl.line = l.line)
+               JOIN
+                 stage AS s
+               ON (l.stage = s.stage)
+               JOIN
+                 rider_race AS rr
+               ON (rl.rider = rr.rider AND s.race = rr.race)
+               WHERE
+                 s.stage = ?
+               AND
+                 \"number\" = 1
+               ", undef, $stage);
+
+       my $results_ref = $dbh->selectall_arrayref("
+               SELECT
+                 rl.rider,
+                 l.line,
+                 l.category,
+                 l.\"type\" AS line_type,
+                 rl.\"number\",
+                 rr.\"type\" AS rider_type,
+                 rr.team
+               FROM
+                 rider_line AS rl
+               JOIN
+                 line AS l
+               ON (rl.line = l.line)
+               JOIN
+                 stage AS s
+               ON (l.stage = s.stage)
+               JOIN
+                 rider_race AS rr
+               ON (rr.rider = rl.rider AND rr.race = s.race)
+               WHERE
+                 l.stage = ?
+               ORDER BY
+                 l.line, rl.\"number\"
+               ", { Slice => {} }, $stage);
+
+       my $insert = $dbh->prepare("
+               INSERT INTO
+                 rider_stage (points, stage, rider)
+               VALUES (?, ?, ?)
+               ");
+
+       my $update = $dbh->prepare("
+               UPDATE
+                 rider_stage
+               SET points = points + ?
+               WHERE stage = ?
+               AND rider = ?
+               ");
+
+       for my $res (@{ $results_ref }) {
+               my $p = get_points($self, $res, $winner_team);
+
+               eval {
+                       $insert->execute($p, $stage, $res->{'rider'});
+               } or do {
+                       $update->execute($p, $stage, $res->{'rider'});
+               };
+       }
+
+       return $self->redirect_to('stage', stage => $stage);
+}
+
+1;
+

diff --git a/lib/Duplo/Session.pm b/lib/Duplo/Session.pm
index 7cf3cf4c37808a2107292b5376280b5024ea70a1..44159f521d7ac563e1b790cd939bf29da5c21d15 100644 (file)
--- a/lib/Duplo/Session.pm
+++ b/lib/Duplo/Session.pm
@@ -17,7 +17,7 @@ sub login {
 
        push @errors, "Empty username." if $user eq '';
 
-       my $res = $dbh->selectrow_hashref("
+       my ($res) = $dbh->selectrow_array("
                SELECT
                  password_hash = crypt(?, password_hash)
                FROM