#!perl
use 5.010;
use strict;
use warnings;
use Test::More;
use File::Temp ();
use File::Spec ();
use File::Path ();
use Cwd ();

# Scaffolding: the project name from the class, the model skeleton per
# engine, the client probe; then `punk sqitch init` and `add --model` end
# to end on SQLite, and the doctor row.

BEGIN {
    @INC = map { File::Spec->rel2abs($_) } @INC;   # the runs chdir
}
use Punk::Sqitch;

sub write_file {
    my ($path, $body) = @_;
    my ($vol, $dir) = File::Spec->splitpath($path);
    File::Path::make_path($dir) if length $dir && !-d $dir;
    open my $fh, '>', $path or die "$path: $!";
    print $fh $body;
    close $fh;
}
sub slurp { my ($p) = @_; open my $fh, '<', $p or die "$p: $!"; local $/; <$fh> }

# ---- the project name -------------------------------------------------------------
is(Punk::Sqitch->project_name_for('MyApp'),        'myapp',        'MyApp -> myapp');
is(Punk::Sqitch->project_name_for('My::App'),      'my_app',       'My::App -> my_app');
is(Punk::Sqitch->project_name_for('Shop::Web::API'), 'shop_web_api', 'deeper, the same');
like(Punk::Sqitch->project_name_for('9lives'), qr/\A[A-Za-z][\w-]*\z/, 'always a name Sqitch accepts');

# ---- the skeleton ----------------------------------------------------------------------
my $meta = {
    table   => 'users',
    fields  => [qw(id email age score active blob)],
    primary => 'id',
    field   => {
        id     => { type => 'integer', primary => 1 },
        email  => { type => 'string', required => 1 },
        age    => { type => 'integer' },
        score  => { type => 'number' },
        active => { type => 'boolean' },
        blob   => { type => 'array' },
    },
};
{
    my $s = Punk::Sqitch->skeleton(meta => $meta, engine => 'sqlite', project => 'myapp',
                                   change => 'users', model => 'MyApp::Model::User');
    like($s->{deploy}, qr/\A-- Deploy myapp:users to sqlite\n-- Generated from MyApp::Model::User by `punk sqitch add --model`: a starting\n/,
        'sqlite deploy: Sqitch\'s own first line, then the provenance and the warning');
    like($s->{deploy}, qr/BEGIN;\n\nCREATE TABLE users \(\n    id INTEGER PRIMARY KEY AUTOINCREMENT,\n    email TEXT NOT NULL,\n    age INTEGER,\n    score REAL,\n    active INTEGER,\n    blob TEXT  -- type 'array' has no mapping; pick one\n\);\n\nCOMMIT;\n\z/,
        'sqlite deploy: the table, in field order, the primary key as autoincrement, required as NOT NULL, an unmapped type flagged');
    like($s->{revert}, qr/-- Revert myapp:users from sqlite\n.*BEGIN;\n\nDROP TABLE users;\n\nCOMMIT;\n\z/s, 'sqlite revert');
    like($s->{verify}, qr/-- Verify myapp:users from sqlite\n.*SELECT id, email, age, score, active, blob\n  FROM users\n WHERE 0;\n/s, 'sqlite verify selects every column from no rows');
}
{
    my $s = Punk::Sqitch->skeleton(meta => $meta, engine => 'pg');
    like($s->{deploy}, qr/CREATE TABLE users \(\n    id bigserial PRIMARY KEY,\n    email text NOT NULL,\n    age bigint,\n    score double precision,\n    active boolean,/, 'pg: its own types and bigserial');
    like($s->{verify}, qr/ WHERE FALSE;/, 'pg: WHERE FALSE');
    like($s->{deploy}, qr/BEGIN;.*COMMIT;/s, 'pg: in a transaction');
}
{
    my $s = Punk::Sqitch->skeleton(meta => $meta, engine => 'mysql');
    like($s->{deploy}, qr/CREATE TABLE users \(\n    id BIGINT PRIMARY KEY AUTO_INCREMENT,\n    email TEXT NOT NULL,\n    age BIGINT,\n    score DOUBLE,\n    active BOOLEAN,/, 'mysql: its own types');
    unlike($s->{deploy}, qr/BEGIN;/, 'mysql: no transaction around DDL');
}
{
    my $s = Punk::Sqitch->skeleton(meta => { table => 't', fields => ['code', 'n'], primary => 'code',
                                             field => { code => { type => 'string' }, n => { type => 'integer' } } },
                                   engine => 'pg');
    like($s->{deploy}, qr/code text PRIMARY KEY,\n    n bigint/, 'a non-integer primary key is the type plus PRIMARY KEY');
    my $e = ''; eval { Punk::Sqitch->skeleton(meta => $meta, engine => 'nope') } or $e = $@;
    like($e, qr/no skeleton types for the 'nope' engine - Punk::Sqitch->register_types\('nope' => \{\.\.\.\}\) adds them \(have: cockroach, firebird, mysql, oracle, pg, sqlite, yugabyte\)/,
        'an engine with no types croaks naming the registrar and what there is');
    like(Punk::Sqitch->skeleton(meta => $meta, engine => 'oracle')->{deploy},
        qr/id NUMBER\(19\) GENERATED BY DEFAULT AS IDENTITY PRIMARY KEY,\n    email VARCHAR2\(4000\) NOT NULL/, 'oracle: its own types');
    like(Punk::Sqitch->skeleton(meta => $meta, engine => 'cockroach')->{deploy}, qr/bigserial PRIMARY KEY/, 'cockroach: pg\'s types');
    Punk::Sqitch->register_types(vertica => { integer => 'BIGINT', string => 'VARCHAR(4000)', number => 'FLOAT',
                                              boolean => 'BOOLEAN', primary_integer => 'IDENTITY PRIMARY KEY', false => 'FALSE' });
    like(Punk::Sqitch->skeleton(meta => $meta, engine => 'vertica')->{deploy}, qr/id IDENTITY PRIMARY KEY/,
        'register_types: an engine added at runtime drafts like the built-ins');
    $e = ''; eval { Punk::Sqitch->register_types(x => { integer => 'I' }) } or $e = $@;
    like($e, qr/register_types x: `string` is required/, 'register_types needs the whole set');
    $e = ''; eval { Punk::Sqitch->skeleton(meta => { table => 'x', fields => [] }, engine => 'pg') } or $e = $@;
    like($e, qr/declares no fields/, 'a model with no fields croaks');
}

# ---- the client probe --------------------------------------------------------------------
{
    my $bin = File::Temp->newdir;
    write_file("$bin/sqlite3", "#!/bin/sh\necho 3.2.0 2010-01-01\n");
    chmod 0755, "$bin/sqlite3";
    local $ENV{PATH} = "$bin";
    my $c = Punk::Sqitch->client_for('sqlite', {});
    is($c->{ok}, 0, 'a sqlite3 older than 3.3.9 is not ok');
    like($c->{why}, qr/sqlite3 3\.2\.0 is older than 3\.3\.9, which Sqitch needs/, 'saying so');
    $c = Punk::Sqitch->client_for('pg', {});
    is($c->{ok}, 0, 'psql not on PATH');
    is($c->{why}, 'psql is not on PATH', 'saying so');
    write_file("$bin/mypsql", "#!/bin/sh\necho 'psql (PostgreSQL) 16.2'\n");
    chmod 0755, "$bin/mypsql";
    $c = Punk::Sqitch->client_for('pg', { 'engine.pg.client' => "$bin/mypsql" });
    is($c->{ok}, 1, 'a client named in sqitch.conf is used');
    is($c->{version}, '16.2', 'and its version read');
    $c = Punk::Sqitch->client_for('oracle', {});
    is($c->{why}, 'sqlplus is not on PATH', 'oracle: Sqitch\'s own client name');
    $c = Punk::Sqitch->client_for('firebird', {});
    is($c->{why}, 'fbsql / isql-fb / isql is not on PATH', 'firebird: every name Sqitch tries, named');
    write_file("$bin/isql", "#!/bin/sh\necho 'isql version 4.0.2'\n");
    chmod 0755, "$bin/isql";
    $c = Punk::Sqitch->client_for('firebird', {});
    is($c->{ok} . ':' . $c->{name}, '1:isql', 'an alternative name on PATH is found');
    $c = Punk::Sqitch->client_for('nope', {});
    like($c->{why}, qr/no client known for the 'nope' engine - Punk::Sqitch->register_client\('nope' => \{\.\.\.\}\) adds one/, 'an unknown engine names the registrar');
    Punk::Sqitch->register_client(nope => { name => 'nope-cli' });
    is(Punk::Sqitch->client_for('nope', {})->{why}, 'nope-cli is not on PATH', 'register_client: and then it is known');
    my $e = ''; eval { Punk::Sqitch->register_client(x => { args => [] }) } or $e = $@;
    like($e, qr/register_client x: `name` is required/, 'register_client needs a name');
}

# ---- end to end ---------------------------------------------------------------------------
SKIP: {
    skip 'Punk, App::Sqitch, DBD::SQLite and the sqlite3 client required', 27
        unless eval { require Punk; require App::Sqitch; require DBI; require DBD::SQLite; 1 }
            && `sqlite3 -version 2>/dev/null` =~ /\A\d/;
    require Punk::Command;
    require Punk::Command::Sqitch;
    no warnings 'once';
    sub punk {
        my ($from, @args) = @_;
        my ($out, $err) = ('', '');
        open my $oh, '>', \$out or die $!;
        open my $eh, '>', \$err or die $!;
        local $Punk::Command::OUT = $oh;
        local $Punk::Command::ERR = $eh;
        my $cwd = Cwd::getcwd();
        chdir $from or die "$from: $!";
        my $code = Punk::Command->main(@args);
        chdir $cwd;
        close $oh; close $eh;
        return ($code, $out, $err);
    }

    my $dir  = File::Temp->newdir;
    my $root = "$dir/app";
    write_file("$root/app.psgi", "use TestApp3; TestApp3->to_app;\n");
    write_file("$root/config/punk.yml", "database:\n  dsn: dbi:SQLite:dbname=var/app.db\n");
    write_file("$root/lib/TestApp3.pm", "package TestApp3;\nuse Punk;\nget '/' => sub { \$_[0]->text('ok') };\n1;\n");
    write_file("$root/lib/TestApp3/Model/User.pm", <<'PM');
package TestApp3::Model::User;
use Punk::Model;
table 'users';
field id    => { type => 'integer', primary => 1 };
field email => { type => 'string', required => 1 };
field age   => { type => 'integer' };
1;
PM
    File::Path::make_path("$root/var");

    # init
    my ($code, $out, $err) = punk($root, 'sqitch', 'init');
    is($code, 0, 'punk sqitch init with nothing: the class and the database fill it in') or diag $err;
    like(slurp("$root/sqitch/sqitch.plan"), qr/^%project=testapp3$/m, 'the project is the class, lowercased');
    like(slurp("$root/sqitch/sqitch.conf"), qr/^\s*engine = sqlite$/m, 'the engine is the database\'s');
    unlike(slurp("$root/sqitch/sqitch.conf"), qr/^\s*target\s*=/m, 'and no target in the conf');
    ok(-d "$root/sqitch/deploy" && -d "$root/sqitch/revert" && -d "$root/sqitch/verify",
        'the script directories, all under sqitch/');
    ok(!-e "$root/sqitch.plan" && !-e "$root/deploy",
        'and nothing Sqitch owns is loose in the application root');

    ($code, $out, $err) = punk($root, 'sqitch', 'init');
    is($code, 1, 'init again is refused');
    like($err, qr/already a Sqitch project \(%project=testapp3\) - the plan is at/, 'naming the project and the plan');

    # an explicit name and engine, in another application with no database
    my $root2 = "$dir/app2";
    write_file("$root2/app.psgi", "use Other; Other->to_app;\n");
    ($code, $out, $err) = punk($root2, 'sqitch', 'init');
    is($code, 2, 'no database and no --engine: a usage error');
    like($err, qr/init needs --engine: no database is configured/, 'saying what is missing');
    ($code, $out, $err) = punk($root2, 'sqitch', 'init', 'explicit', '--engine', 'pg');
    is($code, 0, 'an explicit name and --engine pass straight through') or diag $err;
    like(slurp("$root2/sqitch/sqitch.plan"), qr/^%project=explicit$/m, 'the name given');
    like(slurp("$root2/sqitch/sqitch.conf"), qr/^\s*engine = pg$/m, 'the engine given');

    # add --model
    ($code, $out, $err) = punk($root, 'sqitch', 'add', 'users', '--model', 'User', '-n', 'users table');
    is($code, 0, 'punk sqitch add users --model User') or diag $err;
    like($out, qr/Added "users" to sqitch\.plan/, 'Sqitch added the change');
    like($out, qr/Drafted deploy\/users\.sql from TestApp3::Model::User\nDrafted revert\/users\.sql from TestApp3::Model::User\nDrafted verify\/users\.sql from TestApp3::Model::User/,
        'and the three scripts were drafted from the model');
    my $deploy = slurp("$root/sqitch/deploy/users.sql");
    like($deploy, qr/-- Deploy testapp3:users to sqlite\n-- Generated from TestApp3::Model::User/, 'the deploy script names its origin');
    like($deploy, qr/CREATE TABLE users \(\n    id INTEGER PRIMARY KEY AUTOINCREMENT,\n    email TEXT NOT NULL,\n    age INTEGER\n\);/, 'with the model\'s columns');

    ($code, $out, $err) = punk($root, 'sqitch', 'deploy');
    is($code, 0, 'the drafted change deploys') or diag $err;
    ($code, $out, $err) = punk($root, 'sqitch', 'verify');
    is($code, 0, 'and verifies') or diag $err;
    {
        my $dbh = DBI->connect("dbi:SQLite:dbname=$root/var/app.db", '', '', { RaiseError => 1 });
        my $cols = $dbh->selectcol_arrayref('PRAGMA table_info(users)', { Columns => [2] });
        is_deeply($cols, [qw(id email age)], 'the table has the model\'s columns');
    }

    # a model that does not exist costs no change
    my $plan_before = slurp("$root/sqitch/sqitch.plan");
    ($code, $out, $err) = punk($root, 'sqitch', 'add', 'ghosts', '--model', 'Ghost');
    is($code, 1, 'add --model with no such model is an error');
    like($err, qr/cannot load model TestApp3::Model::Ghost/, 'naming the class it looked for');
    is(slurp("$root/sqitch/sqitch.plan"), $plan_before, 'and the plan is untouched - the model is checked first');

    # add without --model is sqitch's add
    ($code, $out, $err) = punk($root, 'sqitch', 'add', 'plain', '-n', 'plain');
    is($code, 0, 'add without --model');
    unlike($out, qr/Drafted/, 'drafts nothing');
    like(slurp("$root/sqitch/deploy/plain.sql"), qr/-- Deploy testapp3:plain to sqlite/, 'Sqitch\'s own template');

    # the doctor row
    ($code, $out, $err) = punk($root, 'doctor');
    like($out, qr/Punk::Sqitch\s+\S.*App::Sqitch v[\d.]+.*engine sqlite, sqlite3 [\d.]+ on PATH/,
        'doctor: App::Sqitch, the engine, the client and its version');
    {
        local $ENV{PATH} = "$dir/empty";
        ($code, $out, $err) = punk($root, 'doctor');
        like($out, qr/Punk::Sqitch\s+.*engine sqlite: sqlite3 is not on PATH - the deploy host needs it  <- FAILED/,
            'doctor: the client missing is a failed row that says what the deploy host needs');
    }
}

done_testing();
