yhdev/pub/download/code/sqlobject.pl

#!/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;
}