Add SQLObject article

pub/download/code/sqlobject.pl

@@ -0,0 +1,193 @@
+#!/usr/bin/perl
+
+# For info: https://dev.yorhel.nl/doc/sqlobject
+# Date: 2019-08-13
+# License: MIT
+
+use v5.12;
+use warnings;
+use DBIx::Simple;
+use SQL::Interp 'sql';
+use Data::Dumper 'Dumper';
+
+my $db = DBIx::Simple->connect('dbi:Pg:dbname=test', undef, undef, { RaiseError => 1 });
+
+$db->query($_) for (split /;/, <<_);
+DROP SCHEMA IF EXISTS sqlobject_test CASCADE;
+CREATE SCHEMA sqlobject_test;
+SET search_path TO sqlobject_test;
+
+CREATE TABLE games (
+    game_id  integer PRIMARY KEY,
+    title    text
+);
+
+CREATE TABLE releases (
+    release_id    integer PRIMARY KEY,
+    game_id       integer REFERENCES games,
+    release_date  date
+);
+
+CREATE TABLE releases_platforms (
+    release_id  integer REFERENCES releases,
+    platform    text
+);
+
+INSERT INTO games VALUES (7, 'Tsukihime');
+INSERT INTO releases VALUES (339, 7, '2000-12-29');
+INSERT INTO releases VALUES (341, 7, '2006-12-28');
+INSERT INTO releases_platforms VALUES (339, 'Linux');
+INSERT INTO releases_platforms VALUES (339, 'Windows');
+INSERT INTO releases_platforms VALUES (341, 'Windows')
+_
+
+
+{
+    my @games = $db->query('SELECT game_id, title FROM games')->hashes;
+
+    for my $game (@games) {
+        $game->{releases} = [
+            $db->query(
+                'SELECT release_id, release_date FROM releases WHERE game_id = ?',
+                $game->{game_id}
+            )->hashes
+        ];
+    }
+    print Dumper \@games;
+}
+
+
+{
+    # Our abstraction to fetch game entries.
+    my sub fetch_games {
+        my $game_ids = shift;
+        $db->query("SELECT * FROM games WHERE game_id IN($game_ids)")->hashes;
+        # We could be doing some transformations here.
+        # Sorting, pagination, fetching extra information, etc.
+    }
+
+    # We can use that function to fetch games that have already been released.
+    my $ids = "SELECT game_id FROM releases WHERE release_date <= CURRENT_DATE";
+    my @released_games = fetch_games($ids);
+    print Dumper \@released_games;
+}
+
+
+{
+
+    my sub fetch_games {
+        my $game_ids = shift;
+        # Note the use of `iquery` instead of `query`,
+        # this is a DBIx::Simple wrapper around `sql_interp()`.
+        $db->iquery("SELECT * FROM games WHERE game_id IN(", $game_ids, ")")->hashes;
+    }
+
+    my $latest_date = '2019-01-20'; # Our user input
+
+    # This is our "SQL + bind parameters" in a single variable.
+    my $ids = sql("SELECT game_id FROM releases WHERE release_date <=", \$latest_date);
+
+    # ...which can be passed to fetch_games():
+    my @games_with_release_before_latest_date = fetch_games($ids);
+    print Dumper \@games_with_release_before_latest_date;
+}
+
+
+{
+    my @games = $db->query('SELECT game_id, title FROM games')->hashes;
+
+    # List of game_ids, which we can use for our IN() clause.
+    my @game_ids = map $_->{game_id}, @games;
+
+    # Fetch all the releases related to @game_ids.
+    my @releases = $db->iquery(
+        'SELECT game_id, release_id, release_date FROM releases WHERE game_id IN',
+        \@game_ids
+    )->hashes;
+
+    # Create a 'game_id' => [releases] lookup table for quick access
+    my %releases;
+    for my $release (@releases) {
+        # Add this release to %releases and remove the 'game_id' column,
+        # which was only needed for this merging step.
+        push @{$releases{ delete $release->{game_id} }}, $release;
+    }
+
+    # Now merge the release information back into @games
+    for my $game (@games) {
+        $game->{releases} = $releases{ $game->{game_id} } || [];
+    }
+    print Dumper \@games;
+}
+
+
+sub enrich {
+    my($field_name, $merge_field, $sql, @objects) = @_;
+    my %ids = map +($_->{$merge_field}, []), @objects;
+    return if !keys %ids;
+    my @result = $db->iquery( $sql->([keys %ids]) )->hashes;
+    push @{$ids{ delete $_->{$merge_field} }}, $_ for (@result);
+    $_->{ $field_name } = $ids{ $_->{$merge_field} } for (@objects);
+}
+
+
+sub enrich_flatten {
+    # This is the same as the original enrich()
+    my($field_name, $merge_field, $sql, @objects) = @_;
+    my %ids = map +($_->{$merge_field}, []), @objects;
+    return if !keys %ids;
+    my @result = $db->iquery( $sql->([keys %ids]) )->hashes;
+
+    # This is the actual merge strategy, which we'll modify slightly:
+    push @{$ids{ delete $_->{$merge_field} }}, values %$_ for (@result);
+    $_->{ $field_name } = $ids{ $_->{$merge_field} } for (@objects);
+}
+
+
+{
+    my @games = $db->query('SELECT game_id, title FROM games')->hashes;
+
+    enrich 'releases', 'game_id', sub {
+        sql 'SELECT game_id, release_id, release_date FROM releases WHERE game_id IN', $_[0]
+    }, @games;
+
+    # More nesting
+    enrich 'platforms', 'release_id', sub {
+        sql 'SELECT release_id, platform FROM releases_platforms WHERE release_id IN', $_[0]
+    }, map @{$_->{releases}}, @games;
+
+    # Flattened platforms
+    enrich_flatten 'platforms_flat', 'release_id', sub {
+        sql 'SELECT release_id, platform FROM releases_platforms WHERE release_id IN', $_[0]
+    }, map @{$_->{releases}}, @games;
+
+    print Dumper \@games;
+}
+
+
+{
+    my @games = $db->query('SELECT game_id, title FROM games')->hashes;
+
+    # This is the per-game platforms list.
+    enrich_flatten 'platforms', 'game_id', sub {
+        sql 'SELECT DISTINCT game_id, platform
+               FROM releases
+               JOIN releases_platforms USING (release_id)
+              WHERE game_id IN', $_[0]
+    }, @games;
+
+    my $latest_date = '2004-01-20'; # Our user input
+
+    # This is the releases list.
+    enrich 'releases', 'game_id', sub {
+        sql 'SELECT game_id, release_id, release_date,
+                    (SELECT COUNT(*) FROM releases_platforms rp
+                      WHERE rp.release_id = r.release_id) AS platform_count
+               FROM releases r
+              WHERE game_id IN', $_[0], '
+                AND release_date <=', \$latest_date, '
+              ORDER BY release_date'
+    }, @games;
+
+    print Dumper \@games;
+}