Werk verder aan sessies met cookies en databases.

chess_gui/config.yml

@@ -61,7 +61,7 @@ engines:
 #        - /var/sock/memcached
 #      fatal_cluster_unreachable: 0
     Simple:
-      cookie_name: testapp.session
+      cookie_name: dancer.session
 
 #engines:
 #  session:

chess_gui/environments/development.yml

@@ -9,7 +9,7 @@ logger: "console"
 # the log level for this environment
 # core is the lowest, it shows Dancer2's core log messages as well as yours
 # (debug, info, warning and error)
-log: "core"
+log: "debug"
 
 # should Dancer2 show a stacktrace when an 5xx error is caught?
 # if set to yes, public/500.html will be ignored and either

chess_gui/lib/chess_gui.pm

@@ -1,11 +1,12 @@
 #!/usr/bin/env perl
 package chess_gui;
 use Dancer2;
-use Dancer2::Plugin::Ajax;
-use Dancer2::Session::Memcached; # Let's use the database for session storage for now.
+#use Dancer2::Plugin::Ajax;
+#use Dancer2::Session::Memcached;
 use Template;
 use DBI;
 use DBD::Pg;
+#use HTTP::Cookies;
 use strict;
 use warnings;
 #use warnings FATAL => qw(uninitialized);
@@ -54,8 +55,11 @@ my $sth3 = $dbh->prepare(q/INSERT INTO black (b0, b1, k0, n0, n1, p0, p1, p2, p3
 my $sth5 = $dbh->prepare(q/INSERT INTO context (bid, wid, bprio, wprio) VALUES (?, ?, ?, ?)/);
 my $sth6 = $dbh->prepare(q/SELECT id FROM white WHERE b0 = ? and b1 = ? and k0 = ? and n0 = ? and n1 = ? and p0 = ? and p1 = ? and p2 = ? and p3 = ? and p4 = ? and p5 = ? and p6 = ? and p7 = ? and q0 = ? and r0 = ? and r1 = ?/);
 my $sth7 = $dbh->prepare(q/SELECT id FROM black WHERE b0 = ? and b1 = ? and k0 = ? and n0 = ? and n1 = ? and p0 = ? and p1 = ? and p2 = ? and p3 = ? and p4 = ? and p5 = ? and p6 = ? and p7 = ? and q0 = ? and r0 = ? and r1 = ?/);
-my $sth8 = $dbh->prepare(q/SELECT black.b0, black.b1, black.k0, black.n0, black.n1, black.p0, black.p1, black.p2, black.p3, black.p4, black.p5, black.p6, black.p7, black.q0, black.r0, black.r1, white.b0, white.b1, white.k0, white.n0, white.n1, white.p0, white.p1, white.p2, white.p3, white.p4, white.p5, white.p6, white.p7, white.q0, white.r0, white.r1 FROM black, white WHERE (black.id, white.id) IN (SELECT bid, wid FROM sessions WHERE session = ?)/);
-my $sth9 = $dbh->prepare(q/INSERT INTO sessions (session, bid, wid) VALUES ($1, $2, $3) ON CONFLICT ON CONSTRAINT sessions_pkey DO UPDATE SET (bid, wid) = ($2, $3)/);
+#my $sth8 = $dbh->prepare(q/SELECT black.b0, black.b1, black.k0, black.n0, black.n1, black.p0, black.p1, black.p2, black.p3, black.p4, black.p5, black.p6, black.p7, black.q0, black.r0, black.r1, white.b0, white.b1, white.k0, white.n0, white.n1, white.p0, white.p1, white.p2, white.p3, white.p4, white.p5, white.p6, white.p7, white.q0, white.r0, white.r1 FROM black, white WHERE (black.id, white.id) IN (SELECT bid, wid FROM sessions WHERE session = ?)/);
+my $sth8 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6, p7, q0, r0, r1 FROM white WHERE id = ?/);
+my $sth9 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6, p7, q0, r0, r1 FROM black WHERE id = ?/);
+my $sth10 = $dbh->prepare(q/INSERT INTO sessions (session, bid, wid) VALUES ($1, $2, $3) ON CONFLICT ON CONSTRAINT sessions_pkey DO UPDATE SET (session, bid, wid) = ($1, $2, $3)/);
+my $sth11 = $dbh->prepare(q/SELECT bid, wid FROM sessions WHERE session = ?/);
 my (@tree, @what_i_did, %prop, @keys, @pplayer, %tmpalg, %tmpalg2, %tmpalg3, %tmpalg4, $players, @not_player, $smaleer, %pval);
 @not_player[0, 1] = (1, 0);
 my @player = reverse @not_player;
@@ -69,6 +73,7 @@ my $action_limit = 100;
 my $loop_limit = 6;
 my @direction = qw/1 1 1 -1 -1 -1 -1 1 0 1 0 -1 1 0 -1 0 0.5 2 0.5 -2 -0.5 -2 -0.5 2/; # Diagonal direction modifiers: $direction[0..7]. Straight direction modifiers: $direction[8..15]. Knight direction modifiers: $direction[0..7,16..23].
 my @default_iboard;
+my @session_iboard;
 sub INTERRUPT {
     $sth1->finish();
     $sth2->finish();
@@ -78,6 +83,8 @@ sub INTERRUPT {
     $sth7->finish();
     $sth8->finish();
     $sth9->finish();
+    $sth10->finish();
+    $sth11->finish();
     $dbh->disconnect;
     exit 0;
 }
@@ -108,13 +115,19 @@ sub PRETTY_CALC { # Calculate total piece value (for post-game). It used to prin
 }
 
 sub INIT_BOARD {
+my (%h0, %h1);
+if ($#_ != -1) {
+#print $_[0]{'b0'}, "\n";
+    map {if (defined($_[0]{$_})) {$h0{$_[0]{$_}} = join '', (0, $_)}} keys %{$_[0]};
+    map {if (defined($_[1]{$_})) {$h1{$_[1]{$_}} = join '', (1, $_)}} keys %{$_[1]};
+}
     foreach (0..63) { # Initialize chess positions piece worth (%p${player}val).
         my ($x, $y, $player);
 #        $_ = sprintf("%.1o",$_/10); # (This) sprintf doesn't support octal floats.
         $_ = sprintf("%.1f", sprintf("%o", $_)/10);
         $x = int($_);
         $y = $_ * 10 % 10; # 0.x % 1 = 0
-#        if ($#_ == -1) {
+        if ($#_ == -1) {
             if ($y < 2) { # White, hereafter called player 0.
                 $player = 0;
             } elsif ($y > 5) { # Black, hereafter called player 1.
@@ -142,10 +155,11 @@ sub INIT_BOARD {
                 push @{$prop{$_}}, ($player, 'b', $x % 2);
                 $pval{join '', @{$prop{$_}}} = 0.01;
             }
-#        } else { # Restore a previous state.
-            
-#        }
     if (exists($prop{$_})) {$default_iboard[$y][$x] = join '', @{$prop{$_}}}
+
+        } else { # Restore a previous state (from a session).
+            $session_iboard[$y][$x] = $h0{$_} // $h1{$_} // $_;
+        }
     }
     $players = 1; # Could do something with this if it weren't for @not_player...
 }
@@ -168,7 +182,7 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
             my $ditet = $sth1->fetchall_arrayref();
             if ($#$ditet != -1 and defined(${@$ditet[0]}[2/($player+1)+1])) {
                 {no warnings; $tmpalg{join ',', @keys} = ${@$ditet[0]}[2/($player+1)+1]};
-                if ($player == $user_mode and (join '', @{$prop{$asrc}}) eq $_[7] and $_[8] eq $tree[$i]{$asrc}[$c] || $_[8] eq (join '', $prop{$tree[$i]{$asrc}[$c]})) {$tmpalg{join ',', @keys} = 'Inf'; $sth9->execute($_[9], ${@$ditet[0]}[0], ${@$ditet[0]}[1])}
+                if ($player == $user_mode and defined($prop{$asrc}) and (join '', @{$prop{$asrc}}) eq $_[7] and ($_[8] eq $tree[$i]{$asrc}[$c] or (defined($prop{$tree[$i]{$asrc}[$c]}) and $_[8] eq (join '', $prop{$tree[$i]{$asrc}[$c]})))) {$tmpalg{join ',', @keys} = 'Inf'; $sth10->execute($_[9], ${@$ditet[0]}[0], ${@$ditet[0]}[1])}
                 $keys[$i_al] = $asrc;
                 pop @{$tree[$i]{$asrc}};
             } else {
@@ -432,7 +446,8 @@ $sth5->execute($bid, $wid, undef, $tmpalg{$selection});
 $sth5->execute($bid, $wid, $tmpalg{$selection}, undef);
 
                 }
-                if ($player == $user_mode and (join '', @asrc) eq $_[7] and $_[8] eq $adest || $_[8] eq (join '', @adest)) {$tmpalg{$selection} = 'Inf'; $sth9->execute($_[9], $bid, $wid)}
+#                if ($player == $user_mode and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth9->execute($_[9], $bid, $wid)}
+                if ($player == $user_mode and $#asrc != -1 and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth10->execute($_[9], $bid, $wid)}
                 $keys[$i_al] = $asrc;
             }
         }
@@ -702,7 +717,8 @@ $user_mode = 0;
                             $prio = $val;
                         }
                     }
-                    if ($player == $user_mode && $prio != 'Inf') { # Invalid user input.
+                    
+                    if ($player == $user_mode and $prio != 'Inf') { # Invalid user input.
                     $player_turn--;
 #                    push @{$diff{$player}{'warn'}} = 'Reverting an invalid set.';
                     undef $diff{$pplayer[$not_player[$player]]};
@@ -817,6 +833,10 @@ $user_mode = 0;
                     &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 1);
 #                    return;
                 }
+                if ($player != $user_mode) {$keys[$c] = $adest; $sth6->execute(@keys[0..15]); my @wid = $sth6->fetchrow_array(); $sth7->execute(@keys[16..31]); my @bid = $sth7->fetchrow_array(); print $bid[0], ' ', $#bid, ' ', $#wid, ' ', $wid[0], "\n"; $sth10->execute($sessid, $bid[0], $wid[0]); $keys[$c] = $asrc}
+#                if ($player == 0) {
+#                $keys[$c]
+#                }
                 for (my $c = 0; $#keys >= $c; $c++){$keys[$c] = undef and last if defined($keys[$c]) and $keys[$c] == $adest}
                 @{$prop{$adest}} = @{$piece};
                 $keys[$c] = $adest;
@@ -824,6 +844,7 @@ $user_mode = 0;
             } else {
                 @{$prop{$adest}} = @{$piece};
                 $keys[$c] = $adest;
+                if ($player != $user_mode) {$sth6->execute(@keys[0..15]); my @wid = $sth6->fetchrow_array(); $sth7->execute(@keys[16..31]); my @bid = $sth7->fetchrow_array(); $sth10->execute($sessid, $bid[0], $wid[0])}
                 undef $prop{$asrc};
             }
 #            &PRETTY_CALC;
@@ -838,6 +859,8 @@ $user_mode = 0;
     &INIT_BOARD;
     &INIT_KEYS;
 
+#my $jar = HTTP::Cookies->new;
+
 get '/move/:src/:dst' => sub {
 if (session('init')) {
     my %diff = &PROGRAM(route_parameters->get('src'), route_parameters->get('dst'), session); # Includes player input.
@@ -846,22 +869,36 @@ if (session('init')) {
 };
 
 any ['get', 'post'] => '/' => sub {
+    my $session = session; # TODO: I only want %{session}{'id'}.
+    $session = %{$session}{'id'};
+    $sth11->execute($session);
+print $session, "\n";
+    my @sth11 = $sth11->fetchrow_array();
+print $#sth11, "\n";
+    if (session('init') or defined($sth11[0])) {
         if (request->method() eq "POST") {
-if (session('init')) {
             if (length(body_parameters->get('id')) == 1 and body_parameters->get('id') =~ m/\A[1-7]\z/) { # Sanitize user input (even if in a session).
                 my $setting_id = body_parameters->get('id');
                 redirect '/aaaaa';
             }
-}
-    } else {
-if (session('init')) {
-    $sth8->execute(session('id'));
-    template 'index' => {board => $sth8->fetchall_arrayref()};
         } else {
+#           $sth8->execute($session); # TODO: The column name in the hash is without the table name, even if the SQL query includes table names for tables with the same column name (resulting in silently overwritten keys). Workaround with multiple queries.
+            $sth8->execute($sth11[1]);
+            $sth9->execute($sth11[0]);
+#            &INIT_BOARD($sth8->fetchrow_hashref(), $sth9->fetchrow_hashref()); # Complains about attempted modification of RO-value when a piece takes an enemy piece.
+            my $r1 = $sth8->fetchrow_hashref();
+            my $r2 = $sth9->fetchrow_hashref();
+            &INIT_BOARD($r1, $r2);
+#           $sth8->execute($session);
+#           my $hr = $sth8->fetchrow_hashref();
+#           &INIT_BOARD($hr);
+            template 'index' => {board => \@session_iboard};
+        }
+    } elsif (request->method() eq "GET") {
         session 'init' => true;
+#$jar->add_cookie_header($session);
         template 'index' => {board => \@default_iboard};
     }
-    }
 };
 
-true;
+#true;

chess_gui/llll

@@ -0,0 +1,24 @@
+ 42 | 2.7 | 5.7 | 5.6 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 43 | 2.7 | 5.7 | 4.7 | 0.4 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 44 | 2.7 | 5.7 | 4.7 | 4.4 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 45 | 2.7 | 5.7 | 4.7 | 1.3 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 46 | 2.7 | 5.7 | 4.7 | 1.7 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 47 | 2.7 | 5.7 | 4.7 | 3.3 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 48 | 2.7 | 5.7 | 4.7 | 2.5 | 5.5 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 49 | 2.7 | 5.7 | 4.7 | 2.5 | 7.5 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 50 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.5 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 51 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.4 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 52 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.5 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 53 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.4 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 54 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.5 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 55 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.4 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 56 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.5 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 57 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.4 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 58 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.3 | 6.6 |     | 3.7 | 0.7 | 7.7
+ 59 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.5 |     | 3.7 | 0.7 | 7.7
+ 60 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.4 |     | 3.7 | 0.7 | 7.7
+ 61 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 1.7 | 7.7
+ 62 | 2.7 | 5.7 | 4.7 | 2.5 | 6.7 | 0.6 | 1.6 | 2.6 | 3.6 | 4.6 | 5.4 | 6.6 |     | 3.7 | 0.7 | 7.6
+      2.7,  5.7,  4.7,  2.5,  6.7,  0.6,  1.6,  2.6,  3.6,  4.6,  5.4,  6.6,  ,     3.7,  0.7,  7.6
+      2.0 | 5.0 | 4.0 | 1.0 | 7.6 | 0.1 | 1.1 | 2.1 | 3.1 | 4.1 | 5.1 | 6.1 | 7.1 | 3.0 | 0.0 | 7.0
+      2.0,  5.0,  4.0,  1.0,  7.6,  0.1,  1.1,  2.1,  3.1,  4.1,  5.1,  6.1,  7.1,  3.0,  0.0,  7.0,