#!perl -w
$| = 1;

use strict;
use warnings;

use Cwd ();
use File::Copy ();
use File::Path;
use File::Spec ();
use Test::More;

my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY} || "") =~ m/^dbi:Gofer.*transport=/i;

use DBI;

do "./t/lib.pl";

{   # test issue reported in RT#99508
    my @msg;
    my $dbh = eval {
	local $SIG{__WARN__} = sub { push @msg => @_ };
	local $SIG{__DIE__}  = sub { push @msg => @_ };
	DBI->connect ("dbi:DBM:f_dir=./hopefully-doesnt-existst;sql_identifier_case=1;RaiseError=1");
	};
    is ($dbh, undef, "Connect failed");
    like ("@msg", qr{.*hopefully-doesnt-existst.*}, "Cannot open from non-existing directory with attributes in DSN");

    @msg = ();
    $dbh = eval {
	local $SIG{__WARN__} = sub { push @msg => @_ };
	local $SIG{__DIE__}  = sub { push @msg => @_ };
	DBI->connect ("dbi:DBM:", , undef, undef, {
	    f_dir               => "./hopefully-doesnt-existst",
	    sql_identifier_case => 1,
	    RaiseError          => 1,
	    });
	};
    is ($dbh, undef, "Connect failed");
    like ("@msg", qr{.*hopefully-doesnt-existst}, "Cannot open from non-existing directory with attributes in HASH");
    }

my $dir = test_dir ();

my $dbh = DBI->connect ("dbi:DBM:", undef, undef, {
    f_dir               => $dir,
    sql_identifier_case => 1,      # SQL_IC_UPPER
    });

ok ($dbh, "Connect with driver attributes in hash");

ok ($dbh->do ("drop table if exists FRED"), "drop table");

my $dirfext = $^O eq "VMS" ? ".sdbm_dir" : ".dir";

$dbh->do ("create table fred (a integer, b integer)");
ok (-f File::Spec->catfile ($dir, "FRED$dirfext"), "FRED$dirfext exists");

rmtree $dir;
mkpath $dir;

if ($using_dbd_gofer) {
    # can't modify attributes when connect through a Gofer instance
    $dbh->disconnect ();
    $dbh = DBI->connect ("dbi:DBM:", undef, undef, {
	f_dir               => $dir,
	sql_identifier_case => 2,      # SQL_IC_LOWER
	});
    }
else {
    $dbh->dbm_clear_meta ("fred");    # otherwise the col_names are still known!
    $dbh->{sql_identifier_case} = 2;  # SQL_IC_LOWER
    }

$dbh->do ("create table FRED (a integer, b integer)");
ok (-f File::Spec->catfile ($dir, "fred$dirfext"), "fred$dirfext exists");

my $tblfext;
unless ($using_dbd_gofer) {
    $tblfext = $dbh->{dbm_tables}{fred}{f_ext} || "";
    $tblfext =~ s{/r$}{};
    ok (-f File::Spec->catfile ($dir, "fred$tblfext"), "fred$tblfext exists");
    }

ok ($dbh->do ("insert into fRED (a, b) values (1, 2)"),
    "insert into mixed case table");

# but change fRED to FRED and it works.

ok ($dbh->do ("insert into FRED (a, b) values (2, 1)"),
    "insert into uppercase table");

unless ($using_dbd_gofer) {
    my $fn_tbl2 = $dbh->{dbm_tables}{fred}{f_fqfn};
    $fn_tbl2 =~ s/fred(\.[^.]*)?$/freddy$1/;
    my @dbfiles = grep { -f $_ } (
	$dbh->{dbm_tables}{fred}{f_fqfn},
	$dbh->{dbm_tables}{fred}{f_fqln},
	$dbh->{dbm_tables}{fred}{f_fqbn} . ".dir"
	);
    foreach my $fn (@dbfiles) {
	my $tgt_fn = $fn;
	$tgt_fn =~ s/fred(\.[^.]*)?$/freddy$1/;
	File::Copy::copy ($fn, $tgt_fn);
	}
    $dbh->{dbm_tables}{krueger}{file} = $fn_tbl2;

    my $r = $dbh->selectall_arrayref ("select * from Krueger");
    ok (@$r == 2, "rows found via cloned mixed case table");

    ok ($dbh->do ("drop table if exists KRUeGEr"), "drop table");
    }

my $r = $dbh->selectall_arrayref ("select * from Fred");
ok (@$r == 2, "rows found via mixed case table");

SKIP: {
    DBD::DBM::Statement->isa ("SQL::Statement")
	or skip ("quoted identifiers aren't supported by DBI::SQL::Nano", 1);
    my $abs_tbl = File::Spec->catfile ($dir, "fred");
    # work around SQL::Statement bug
    DBD::DBM::Statement->isa ("SQL::Statement")
	and SQL::Statement->VERSION () lt "1.32"
	and $abs_tbl =~ s{\\}{/}g;
    $r = $dbh->selectall_arrayref (sprintf 'select * from "%s"', $abs_tbl);
    ok (@$r == 2, "rows found via select via fully qualified path");
    }

if ($using_dbd_gofer) {
    ok ($dbh->do ("drop table if exists FRED"),        "drop table");
    ok (!-f File::Spec->catfile ($dir, "fred$dirfext"), "fred$dirfext removed");
    }
else {
    my $tbl_info = {file => "fred$tblfext"};

    ok ($dbh->disconnect (), "disconnect");
    $dbh = DBI->connect ("dbi:DBM:", undef, undef, {
	f_dir               => $dir,
	sql_identifier_case => 2,                     # SQL_IC_LOWER
	dbm_tables          => {fred => $tbl_info},
	});

    my @tbl;
    @tbl = $dbh->tables (undef, undef, undef, undef);
    is (scalar @tbl, 1, "Found 1 tables");

    $r = $dbh->selectall_arrayref ("select * from Fred");
    ok (@$r == 2, "rows found after reconnect using 'dbm_tables'");

    my $deep_dir = File::Spec->catdir ($dir, "deep");
    mkpath $deep_dir;

    $dbh = DBI->connect ("dbi:DBM:", undef, undef, {
	f_dir               => $deep_dir,
	sql_identifier_case => 2,           # SQL_IC_LOWER
	});
    ok ($dbh->do ("create table wilma (a integer, b char (10))"), "Create wilma");
    ok ($dbh->do ("insert into wilma values (1, 'Barney')"), "insert Barney");
    ok ($dbh->disconnect (),                                  "disconnect");

    $dbh = DBI->connect ("dbi:DBM:", undef, undef, {
	f_dir               => $dir,
	sql_identifier_case => 2,           # SQL_IC_LOWER
	});

    # Make sure wilma is not found without f_dir_search
    @tbl = $dbh->tables (undef, undef, undef, undef);
    is (scalar @tbl, 1, "Found 1 table");
    ok ($dbh->disconnect (), "disconnect");

    $dbh = DBI->connect ("dbi:DBM:", undef, undef, {
	f_dir               => $dir,
	f_dir_search        => [ $deep_dir ],
	sql_identifier_case => 2,             # SQL_IC_LOWER
	});

    @tbl = $dbh->tables (undef, undef, undef, undef);
    is (scalar @tbl, 2, "Found 2 tables");
    # f_dir should always appear before f_dir_search
    like ($tbl[0], qr{(?:^|\.)fred$}i,  "Fred first");
    like ($tbl[1], qr{(?:^|\.)wilma$}i, "Fred second");

    my ($n, $sth);
    ok ($sth = $dbh->prepare ("select * from fred"), "select from fred");
    ok ($sth->execute,                               "execute fred");
    $n = 0;
    $n++ while $sth->fetch;
    is ($n, 2, "2 entry in fred");
    ok ($sth = $dbh->prepare ("select * from wilma"), "select from wilma");
    ok ($sth->execute,                                "execute wilma");
    $n = 0;
    $n++ while $sth->fetch;
    is ($n, 1, "1 entry in wilma");

    ok ($dbh->do (q/drop table if exists FRED/), "drop table fred");
    ok (!-f File::Spec->catfile ($dir, "fred$dirfext"), "fred$dirfext removed");
    ok (!-f File::Spec->catfile ($dir, "fred$tblfext"), "fred$tblfext removed");

    ok ($dbh->do (q/drop table if exists wilma/), "drop table wilma");
    ok (!-f File::Spec->catfile ($deep_dir, "wilma$dirfext"),
	"wilma$dirfext removed");
    ok (!-f File::Spec->catfile ($deep_dir, "wilma$tblfext"),
	"wilma$tblfext removed");
    }

unless ($using_dbd_gofer) {
    ok ($dbh = DBI->connect ("dbi:DBM:", undef, undef, {
	f_dir        => $dir,
	f_dir_search => [ "t" ],
	}), "New dbh for CVE");
    $dbh->{dbm_tables}{fred}{file} = 
	File::Spec->catdir (Cwd::abs_path (
	File::Spec->catdir ($dir, "..")), "fred");
    my @msg;
    eval {
	local $SIG{__DIE__} = sub { push @msg => @_ };
	local $dbh->{PrintError} = 0;
	$dbh->do ("create table fred (a integer, b integer)");
	};
    like ("@msg", qr{is unsafe and not allowed}, "unsafe is caught");
    }

done_testing ();
