#!/usr/bin/env perl -w

use strict;
use warnings;

use Test::More;
use DBIx::Connector;

my (@table_sql, $dsn, $user, $pass);

if (exists $ENV{DBICTEST_DSN}) {
    ($dsn, $user, $pass) = @ENV{map { "DBICTEST_${_}" } qw/DSN USER PASS/};
    my $driver = (DBI->parse_dsn($dsn))[1];
    if ($driver eq 'Pg') {
        @table_sql = (q{
            SET client_min_messages = warning;
            DROP TABLE IF EXISTS artist;
            CREATE TABLE artist (id serial PRIMARY KEY, name TEXT);
        });
    } elsif ($driver eq 'SQLite') {
        @table_sql = (
            'DROP TABLE IF EXISTS artist',
            q{CREATE TABLE artist (
                 id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, name TEXT
             )},
        );
    } elsif ($driver eq 'Firebird') {
        @table_sql = (
            q{RECREATE TABLE artist (id INTEGER, name VARCHAR(100))},
        );
    } elsif ($driver eq 'mysql') {
        @table_sql = (
             'DROP TABLE IF EXISTS artist;',
             q{CREATE TABLE artist (
                 id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name TEXT
             ) ENGINE=InnoDB;
        });
    } else {
        plan skip_all => 'Set DBICTEST_DSN _USER and _PASS to run savepoint tests';
    }
} else {
    plan skip_all => 'Set DBICTEST_DSN _USER and _PASS to run savepoint tests';
}

plan tests => 38;

ok my $conn = DBIx::Connector->new($dsn, $user, $pass, {
    PrintError => 0,
    RaiseError => 1,
}), 'Get a connection';
diag "Connecting to $dsn";
ok my $dbh = $conn->dbh, 'Get the database handle';
isa_ok $dbh, 'DBI::db', 'The handle';

$dbh->do($_) for (
    @table_sql,
    "INSERT INTO artist (id, name) VALUES(1, 'foo')",
);

pass 'Table created';

my $sel = $dbh->prepare('SELECT name FROM artist WHERE id = 1');
my $upd = $dbh->prepare('UPDATE artist SET name = ? WHERE id = 1');

ok $dbh->begin_work, 'Start a transaction';
is $dbh->selectrow_array($sel), 'foo', 'Name should be "foo"';
my $driver = $conn->driver;

# First off, test a generated savepoint name
ok $driver->savepoint($dbh, 'foo'), 'Savepoint "foo"';
ok $upd->execute('Jheephizzy'), 'Update to "Jheephizzy"';
is $dbh->selectrow_array($sel), 'Jheephizzy', 'The name should now be "Jheephizzy"';

# Rollback the generated name
# Active: 0
ok $driver->rollback_to($dbh, 'foo'), 'Rollback the to "foo"';
is $dbh->selectrow_array($sel), 'foo', 'Name should be "foo" again';

ok $upd->execute('Jheephizzy'), 'Update to "Jheephizzy" again';

# Active: 0
ok $driver->savepoint($dbh, 'testing1'), 'Savepoint testing1';
ok $upd->execute('yourmom'), 'Update to "yourmom"';

# Active: 0 1
ok $driver->savepoint($dbh, 'testing2'), 'Savepont testing2';
ok $upd->execute('gphat'), 'Update to "gphat"';
is $dbh->selectrow_array($sel), 'gphat', 'Name should be "gphat"';

# Active: 0 1
# Rollback doesn't DESTROY the savepoint, it just rolls back to the value
# at it's conception
ok $driver->rollback_to($dbh, 'testing2'), 'Rollback testing2';
is $dbh->selectrow_array($sel), 'yourmom', 'Name should be "yourmom"';

# Active: 0 1 2
ok $driver->savepoint($dbh, 'testing3'), 'Savepoint testing3';
ok $upd->execute('coryg'), 'Update to "coryg"';
# Active: 0 1 2 3
ok $driver->savepoint($dbh, 'testing4'), 'Savepoint testing4';
ok $upd->execute('watson'), 'Update to "watson"';

# Release 3, which implicitly releases 4
# Active: 0 1
ok $driver->release($dbh, 'testing3'), 'Release testing3';
is $dbh->selectrow_array($sel), 'watson', 'Name should be "watson"';

# This rolls back savepoint 2
# Active: 0 1
ok $driver->rollback_to($dbh, 'testing2'), 'Rollback to [savepoint2]';
is $dbh->selectrow_array($sel), 'yourmom', 'Name should be "yourmom" again';

# Rollback the original savepoint, taking us back to the beginning, implicitly
# rolling back savepoint 1
ok $driver->rollback_to($dbh, 'foo'), 'Rollback to the beginning';
is $dbh->selectrow_array($sel), 'foo', 'Name should be "foo" once more';

ok $dbh->commit, 'Commit the changes';

# And now to see if svp will behave correctly
$conn->svp (sub {
    $conn->txn( fixup => sub { $upd->execute('Muff') });

    eval {
        $conn->svp(sub {
            $upd->execute('Moff');
            is $dbh->selectrow_array($sel), 'Moff', 'Name should be "Moff" in nested transaction';
            shift->do('SELECT gack from artist');
        });
    };
    ok $@,'Nested transaction failed (good)';
    is $dbh->selectrow_array($sel), 'Muff', 'Rolled back name should be "Muff"';
    $upd->execute('Miff');
});

is $dbh->selectrow_array($sel), 'Miff', 'Savepoint worked: name is "Muff"';

$conn->txn(fixup => sub {
  my ($dbh) = @_;
  $dbh->do("DELETE FROM artist;");
  $dbh->do("INSERT INTO artist (name) VALUES ('All-Time Quarterback');");

  my $token = \do { my $x = "TURN IT OFF" };

  my $ok = eval {
    $conn->svp(sub {
      my ($dbh) = @_;
      $dbh->do("INSERT INTO artist (name) VALUES ('Britney Spears');");
      die $token;
    });
    1;
  };
  my $error = $@;

  ok( ! $ok, "we didn't survive our svp");
  ok(
    (ref $error  && ref $error eq 'SCALAR' && $error == $token),
    "we got the expected error, too"
  ) or diag "got error: $error";

  $dbh->do("INSERT INTO artist (name) VALUES ('Cyndi Lauper');");
});

$conn->txn(sub {
  my ($dbh) = @_;
  my $rows = $dbh->selectcol_arrayref("SELECT name FROM artist ORDER BY name");
  is(@$rows, 2, "we inserted 2 rows");
  is_deeply(
    $rows,
    [ 'All-Time Quarterback', 'Cyndi Lauper' ],
    "...and we omitted the bad one",
  );
});