package # hide from PAUSE
    CDTest;

use strict;
use warnings;

use CDTest::Schema;
use Class::Load       qw< is_class_loaded >;
use Env               qw< CDTEST_DSN CDTEST_MASS_POPULATE >;
use Path::Class::File ();

=head1 NAME

CDTest - Small-scale DBIC test module

=head1 SYNOPSIS

    use lib qw(t/lib);
    use CDTest;
    use Test2::Bundle::More;

    my $schema = CDTest->init_schema;

=head1 DESCRIPTION

This module provides a test DBIC schema in a real SQLite DB.  Much of this was stolen and
stripped down from DBICTest in DBIC's test platform.

=head1 METHODS

=head2 init_schema

    my $schema = CDTest->init_schema(
        # Defaults
        no_connect  => 0,
        no_deploy   => 0,
        no_preclean => 0,
        no_populate => 0,
    );

    my $schema = CDTest->init_schema(
        mass_populate => 100,
    );

This method creates a new, empty, in-memory SQLite database and then creates a new, empty database.
If C<CDTEST_DSN>, C<CDTEST_DBUSER>, and C<CDTEST_DBPASS> are specified, it will use that database
instead.  Make sure the database doesn't have any useful data in it.

This method will call L</deploy_schema> by default, unless the C<no_deploy> flag is set.

It will also call L</clean_schema> by default, unless the C<no_preclean> flag is set, or the SQLite
in-memory DB is used (which is the default).

Also, by default, this method will call L</populate_schema>, unless the C<no_deploy> or
C<no_populate> flags are set.

If C<mass_populate> or C<CDTEST_MASS_POPULATE> is set, L</mass_populate_schema> will be called
instead, with the number of batches specified.

=cut

sub _database {
    my $self = shift;
    my %args = @_;

    if ($CDTEST_DSN) {
        return (
            (map { $ENV{"CDTEST_${_}"} || '' } qw/DSN DBUSER DBPASS/),
            { AutoCommit => 1, %args },
        );
    }

    return ("dbi:SQLite::memory:", '', '', {
        AutoCommit => 1,

        # SQLite needs FKs turned on after connect
        on_connect_do => sub {
            my $storage = shift;
            my $dbh = $storage->_get_dbh;

            $dbh->do('PRAGMA foreign_keys = ON');
        },
    });
}

sub init_schema {
    my $self = shift;
    my %args = @_;

    my @dbi_args = $self->_database(%args);

    $args{mass_populate} ||= $CDTEST_MASS_POPULATE if $CDTEST_MASS_POPULATE;

    my $schema = CDTest::Schema->compose_namespace('CDTest');

    unless ($args{no_connect}) {
        $schema = $schema->connect(@dbi_args);

        # Advertise the DBMS version
        if (is_class_loaded('Test2::Tools::Basic')) {
            my $dbh = $schema->storage->dbh;
            Test2::Tools::Basic::note($dbh->get_info(17)." version ".$dbh->get_info(18));  # SQL_DBMS_NAME+VER
        }
    }
    else {
        return $schema
    }

    unless ($args{no_preclean} || $dbi_args[0] =~ /^dbi:SQLite::memory:/) {  # :memory: needs no pre-cleanup
        $self->clean_schema( $schema );
    }
    unless ($args{no_deploy}) {
        $self->deploy_schema( $schema );
        unless ($args{no_populate}) {
            if ($args{mass_populate}) { $self->mass_populate_schema( $schema, $args{mass_populate} ) }
            else                      { $self->populate_schema( $schema ); }
        }
    }

    return $schema;
}

=head2 dbms_name

    my $dbms_name = CDTest->dbms_name;

Acquires the driver name without connecting to anything.

=cut

sub dbms_name {
    my $self = shift;

    if ($CDTEST_DSN && $CDTEST_DSN =~ /^dbi:(\w+)/) {
        my $driver = $1;
        my $drh = DBI->install_driver($driver);
        my $bare_dbh = DBI::_new_dbh($drh, {});

        return $bare_dbh->get_info(17);  # SQL_DBMS_NAME
    }
    else {
        return 'SQLite';
    }
}

=head2 deploy_schema

    CDTest->deploy_schema( $schema );

Deploys the C<sqlite.sql> schema into the SQLite DB.

=cut

sub deploy_schema {
    my $self   = shift;
    my $schema = shift;
    my $dbh    = $schema->storage->dbh;

    my $file = Path::Class::File->new(__FILE__)->dir->file('sqlite.sql');
    my $sql  = $file->slurp(iomode => '<:encoding(UTF-8)');

    # Clean the SQL to work with whatever RDBMS we're using
    my $dbms_name = $self->dbms_name;
    unless ($dbms_name eq 'SQLite') {
        $sql =~ s/\"(\w+)\"/$dbh->quote_identifier($1)/ge;
    }
    if ($dbms_name eq 'MySQL') {
        $sql =~ s/(PRIMARY KEY NOT NULL)/AUTO_INCREMENT $1/g;
    }

    $schema->multi_do($sql);
}

=head2 clean_schema

    CDTest->clean_schema( $schema );

Drops all of the tables in the schema.

=cut

sub clean_schema {
    my $self   = shift;
    my $schema = shift;
    my $dbh    = $schema->storage->dbh;

    my $dbms_name = $self->dbms_name;

    # Turn off FK constraints
    if    ($dbms_name eq 'SQLite') {
        $dbh->do('PRAGMA foreign_keys = OFF');
    }
    elsif ($dbms_name eq 'MySQL') {
        $dbh->do('SET SESSION foreign_key_checks=0');
    }

    foreach my $source_name (sort $schema->sources) {
        my $rsrc  = $schema->source($source_name);
        my $table = $rsrc->from;

        my $type = $rsrc->isa('DBIx::Class::ResultSource::View') ? 'VIEW' : 'TABLE';

        $dbh->do("DROP $type IF EXISTS ".$dbh->quote_identifier($table));
    }
}

=head2 populate_schema

    CDTest->populate_schema( $schema );

After you deploy your schema, you can use this method to populate the tables with test data.

=cut

sub populate_schema {
    my $self   = shift;
    my $schema = shift;

    $schema->populate('Genre', [
        [qw/genreid name/],
        [qw/1       emo /],
        [qw/2       downtempo /],
        [qw/3       soundtrack /],
    ]);

    $schema->populate('Artist', [
        [ qw/artistid name/ ],
        [ 1, 'Caterwauler McCrae' ],
        [ 2, 'Random Boy Band' ],
        [ 3, 'We Are Goth' ],
        # These gaps are intentional
        [ 10, 'Torroni' ],
        [ 11, 'The yy'  ],
        [ 12, 'Kent'    ],
        [ 15, 'A582'    ],
        [ 17, 'Lunar Eclipse' ],
    ]);

    $schema->populate('CD', [
        [ qw/cdid artist title year prev_cdid genreid/ ],
        [ 1, 1, "Spoonful of bees", 1999, undef, 1 ],
        [ 2, 1, "Forkful of bees", 2001, 1 ],
        [ 3, 1, "Caterwaulin' Blues", 1997, 2 ],
        [ 4, 2, "Generic Manufactured Singles", 2001 ],
        [ 5, 3, "Come Be Depressed With Us", 1998 ],

        [ 9,  10, "Me and You", 2007, undef, 2 ],
        [ 10, 11, "Co-Founder", 2011, undef, 2 ],
        [ 11, 12, "Independence Park", 2001 ],
        [ 15, 12, "Flaming Dragon", 2007, 11 ],
        [ 16, 12, "Kent", 2014, 15 ],
        [ 17, 15, "42 Minutes of Silence", 2011 ],
        [ 19, 15, "Two", 2012, 17 ],
        [ 21, 15, "852", 2015, 19 ],
        [ 22, 17, "Glass Window Soundtrack", 2009 ],
        [ 24, 17, "Magenta", 2014, 22 ],
        [ 25, 17, "Yellow", 2014, 24 ],
        [ 30, 17, "Cyan", 2014, 25 ],
    ]);

    $schema->populate('Tag', [
        [ qw/tagid cd tag/ ],
        [ 1, 1, "Blue" ],
        [ 2, 2, "Blue" ],
        [ 3, 3, "Blue" ],
        [ 4, 5, "Blue" ],
        [ 5, 2, "Cheesy" ],
        [ 6, 4, "Cheesy" ],
        [ 7, 5, "Cheesy" ],
        [ 8, 2, "Shiny" ],
        [ 9, 4, "Shiny" ],
    ]);

    $schema->populate('Producer', [
        [ qw/producerid name/ ],
        [ 1, 'Matt S Trout' ],
        [ 2, 'Bob The Builder' ],
        [ 3, 'Fred The Phenotype' ],
        [ 4, 'Various' ],
    ]);

    $schema->populate('CDToProducer', [
        [ qw/cd producer/ ],
        [ 1, 1 ],
        [ 1, 2 ],
        [ 1, 3 ],
        [ 2, 2 ],
        [ 3, 2 ],
        [ 3, 3 ],
        [ 4, 1 ],
        map { [ $_, 4 ] } qw< 9 10 11 15 16 17 19 21 22 24 25 30 >,
    ]);

    $schema->populate('Track', [
        [ qw/trackid cd  position title/ ],
        [ 4, 2, 1, "Stung with Success"],
        [ 5, 2, 2, "Stripy"],
        [ 6, 2, 3, "Sticky Honey"],
        [ 7, 3, 1, "Yowlin"],
        [ 8, 3, 2, "Howlin"],
        [ 9, 3, 3, "Fowlin"],
        [ 10, 4, 1, "Boring Name"],
        [ 11, 4, 2, "Boring Song"],
        [ 12, 4, 3, "No More Ideas"],
        [ 13, 5, 1, "Sad"],
        [ 14, 5, 2, "Under The Weather"],
        [ 15, 5, 3, "Suicidal"],
        [ 16, 1, 1, "The Bees Knees"],
        [ 17, 1, 2, "Apiary"],
        [ 18, 1, 3, "Beehind You"],

        [ 20, 9, 1, "Diamond Circus"],
        [ 21, 9, 2, "We're Crazy"],
        [ 22, 9, 3, "First Heart"],
        [ 23, 10, 1, "World Of Old"],
        [ 24, 10, 2, "Story Of More"],
        [ 26, 10, 3, "Home Secrets"],
        [ 27, 10, 4, "Matter Of Right Now"],
        [ 28, 11, 1, "Dance Tales"],
        [ 29, 11, 2, "She Hopes We Like To Party"],
        [ 30, 11, 3, "Stop Rhythm"],
        [ 32, 15, 1, "Story Of My Party"],
        [ 33, 15, 2, "Finding Her Fire"],
        [ 34, 16, 1, "Crispy Dreams"],
        [ 35, 16, 2, "Kent"],
        [ 36, 16, 3, "Superman"],
        [ 38, 17, 1, "42 Minutes of Silence"],
        [ 40, 19, 1, "Surface Tension"],
        [ 44, 19, 2, "This Could Totally Work"],
        [ 45, 19, 3, "Off-By-One Errors"],
        [ 46, 19, 4, "Two"],
        [ 47, 21, 1, "Enemy"],
        [ 48, 21, 2, "Gamma"],
        [ 50, 21, 3, "258"],
        [ 55, 21, 4, "Genetic Macroeconomics"],
        [ 56, 22, 1, "That One Spot in the Game"],
        [ 57, 22, 2, "Leitmotif"],
        [ 58, 22, 3, "The Part Where He Kills You"],
        [ 59, 24, 1, "Magenta"],
        [ 65, 25, 1, "Yellow"],
        [ 70, 30, 1, "Cyan"],
    ]);
}

=head2 mass_populate_schema

    CDTest->mass_populate_schema( $schema, $batches );

Populate the schema with massive amounts of data, mostly as duplicates of different rows.

The C<$batches> are measured in thousands of artists.  In other words, one batch is:

    1000   artists
    ~2500  CDs
    ~20000 tracks

Just 10 batches takes up quite a bit of space (around 100MB of memory in the SQLite in-memory DB),
and takes around 30 seconds to populate.

=cut

sub mass_populate_schema {
    my ($self, $schema, $batches) = @_;
    $batches ||= 10;

    for (1 .. $batches) {
        if (is_class_loaded('Test2::Tools::Basic')) {
            Test2::Tools::Basic::note("Mass populating data: $_,000 records");
        }

        # Create 1000 fake artists
        my $artist_rows = [ [ qw/name/ ] ];
        my $track_rows  = [ [ qw/cd position title/ ] ];

        for (1 .. 1000) {
            push @$artist_rows, [ $self->_random_words ];
        }
        my @artists = $schema->populate('Artist', $artist_rows);

        # Create a bunch of fake albums
        while (my $artist = shift @artists) {
            my $cd_rows = [ [ qw/artist title year/ ] ];
            for (1 .. int(rand 5)+1) {
                push @$cd_rows, [
                    $artist->artistid,
                    $self->_random_words,
                    1950 + int(rand(68)),
                ];
            }
            my @cds = $schema->populate('CD', $cd_rows);

            # Create a bunch of fake tracks
            while (my $cd = shift @cds) {
                for (1 .. int(rand 15)+1) {
                    push @$track_rows, [
                        $cd->cdid,
                        $_,
                        $self->_random_words,
                    ];
                }
            }
        }

        # Push these in one big batch (since we don't need the rows)
        $schema->populate('Track', $track_rows);
    }
}

my @letters        = map { chr } (97..122);
my @vowel_patterns = qw<
    e i a o u y io ia ou ie ea oo ee ai oi au eu ua ui ei oa eo ue iou oe ae iu ay eou yo ya
    yi ey ye uo oy uou eye aye ao aeo eau ii oya aya aa ayi ioi uie yu oye eei
>;
my @conson_patterns = qw<
    n r t s l c d m p v b g ng st nt ss f ll h nd pr z bl ph tr ns rs k nc w ch th ct sh x
    rm gr sc cr rt sm sp rr tt pl br rd ck q mp cl nn str pt dr rn rc mm j ps sl mb fl rg
    ngl rb lt rl pp nf ntr gl ff sn ls gn nr ts nv fr cc rp dl nch rv nl gg ld nm nk rch np
    nh sk rk rh dn wh rf ngs bb ntl ds dd tch nts nth ght ms lm ln chr scr sts
>;

sub _random_word {
    # Random word generator
    my $word = $letters[int rand @letters];
    return uc $word if rand() <= .01;

    while (rand >= .33 || length $word < 2) {
        $word .= $vowel_patterns [int rand @vowel_patterns ];
        $word .= $conson_patterns[int rand @conson_patterns];
        last if length $word > 20;
    }

    return ucfirst $word;
}

sub _random_words {
    my $self = shift;
    my @words = map { $self->_random_word } (1 .. int(rand 4)+1);
    my $words = join ' ', @words;
    $words .= ' '.$self->_random_word unless length $words > 20;
    return $words;
}

1;

