#!perl -T
use strict;
use Test::More tests => 53;
use Data::Dumper;
use lib '.';
use t::common qw(new_fh);
use warnings;
no warnings 'uninitialized';

BEGIN {
	use_ok( 'DBIx::Declare' );
}

SKIP: {
	my $drh = eval {DBI->install_driver("SQLite")};
	diag($@) if $@;
	skip "DBD::SQLite not available", 52 unless $drh;

	diag( "Testing DBIx::Declare $DBIx::Declare::VERSION, DBI $DBI::VERSION, DBD::SQLite $DBD::SQLite::VERSION, Perl $], $^X" );

	my ($fh,$filename) = new_fh();

	my $dbh = eval{ DBI->connect("dbi:SQLite:dbname=$filename", '', '', { 'RaiseError' => 0, PrintError => 0, 'AutoCommit' => 1 })};
	unless ($dbh) {
		diag("Failed to create the SQLite database in $filename");
		skip ": can't create SQLite database", 52;
	}

DBIx::Declare->import(
	MyDB => {
#	code_cache => 'W:\jenda\packages\DBIx\Declare\t\cache',
	data_source  => "dbi:SQLite:dbname=$filename",
	user => '',
	pass => '',
	attr => { 'RaiseError' => 0, PrintError => 0, 'AutoCommit' => 1 },
	on_errors => 'croak',
	methods => {
		'CreateTableUsers' => {
			sql => 'CREATE TABLE DBIx_Declare_Users (Id int not NULL PRIMARY KEY, FirstName varchar(50) NOT NULL, LastName varchar(50) NOT NULL, Email varchar(100))',
			args => [],
			return => '$',
			noprepare => 1,
			#noquote => 1,
		},
		'DropTableUsers' => {
			sql => 'DROP TABLE DBIx_Declare_Users',
			args => [],
			return => '$',
			noprepare => 1,
			#noquote => 1,
		},
		'CreateTableUsers_Autoincrement' => {
			sql => 'CREATE TABLE DBIx_Declare_Users (Id integer PRIMARY KEY autoincrement, FirstName varchar(50) NOT NULL, LastName varchar(50) NOT NULL, Email varchar(100))',
			args => [],
			return => '$',
			noprepare => 1,
			#noquote => 1, # pointless with no arguments
		},
		'InsertUser' => {
			sql => 'INSERT INTO DBIx_Declare_Users (Id,FirstName,LastName,Email) VALUES (?,?,?,?)',
			args => [qw(Id FirstName LastName Email)],
			defaults => {
				Email => undef,
			},
			return => '$',
		},
		'UpdateUser' => {
			sql => 'UPDATE DBIx_Declare_Users SET FirstName = COALESCE(?,FirstName), LastName = COALESCE(?,LastName), Email = COALESCE(?,Email) WHERE Id = ?',
			args => [qw(FirstName LastName Email Id)],
			defaults => {
				Email => undef,
				LastName => undef,
				FirstName => undef,
			},
			return => '$',
		},
		DeleteUser => {
			sql => 'DELETE FROM DBIx_Declare_Users WHERE Id = ?',
			args => ['Id'],
			return => '$',
		},
		DeleteAllUsers => {
			sql => 'DELETE FROM DBIx_Declare_Users',
			args => [],
			return => '$',
		},
		FetchUserDetails => {
			sql => 'SELECT * FROM DBIx_Declare_Users WHERE Id = ?',
			args => ['Id'],
			return => '%',
		},
		FetchUsers => {
			sql => 'SELECT * FROM DBIx_Declare_Users ORDER BY LastName, FirstName',
			args => [],
			return => '@@',
		},
		FetchUsersWithNames => {
			sql => 'SELECT * FROM DBIx_Declare_Users ORDER BY LastName, FirstName',
			args => [],
			return => '@%',
		},
		InsertUserID => {
			sql => 'INSERT INTO DBIx_Declare_Users (FirstName,LastName,Email) VALUES (?,?,?)',
			args => [qw(FirstName LastName Email)],
			defaults => {
				Email => undef,
			},
			return => '++',
		},
		FetchUserDetailsA => {
			sql => 'SELECT * FROM DBIx_Declare_Users WHERE Id = ?',
			args => ['Id'],
			return => '_@',
		},
		'FetchUsersA,FetchUsersHNDL,FetchUsersSA,FetchUsersSRA,FetchUsersSH,FetchUsersSRH,
		 FetchUsersOA,FetchUsersORA,FetchUsersOH,FetchUsersORH,' => {
			sql => 'SELECT * FROM DBIx_Declare_Users ORDER BY LastName, FirstName',
			args => [],
		},
		FetchUsersA => {return => '@'},
		FetchUsersHNDL => {return => '<>'},
		FetchUsersSA => {return => '&@', sub => sub {my ($id,$fn,$ln,$e) = @_; return "$id: $fn $ln <$e>" }},
		FetchUsersSRA => {return => '&\@', sub => sub {my ($a) = @_; return "$a->[0]: $a->[1] $a->[2] <$a->[3]>"}},
		FetchUsersSH => {return => '&%', sub => sub {my %h = @_; return "$h{Id}: $h{FirstName} $h{LastName} <$h{Email}>"}},
		FetchUsersSRH => {return => '&\%', sub => sub {my ($h) = @_; return "$h->{Id}: $h->{FirstName} $h->{LastName} <$h->{Email}>"}},
		FetchUsersOA => {return => '.@', class => 'ClsA'},
		FetchUsersORA => {return => '.\@', class => 'ClsRA'},
		FetchUsersOH => {return => '.%', class => 'ClsH'},
		FetchUsersORH => {return => '.\%', class => 'ClsRH'},
	},
});

my $db = MyDB->new();
END {
	$db->_Disconnect();
undef $db; close $fh;
};

ok($db && ref($db), 'database access object created');

ok($db->CreateTableUsers(), 'table dbo.DBIx_Declare_Users created');

ok($db->InsertUser(1, 'John', 'Doe', 'John.Doe@hotmail.com'), 'Insert a user with positional arguments');
ok($db->InsertUser(-Id => 2, -FirstName => 'Jane', -LastName => 'Doe', -Email => 'Jane.Doe@hotmail.com'), 'Insert a user with named arguments');

ok($db->InsertUser(3, 'Ken', 'Plastic'), 'Insert a user with positional arguments and default');
ok($db->InsertUser(-Id => 4, -FirstName => 'Barbie', -LastName => 'Blond'), 'Insert a user with named arguments and a default');
ok($db->InsertUser(-FirstName => 'Corrie', -Id => 5, -LastName => 'McDowel'), 'Insert a user with named arguments and a default with different order');

is_deeply( scalar($db->FetchUserDetails(2)), {Id => 2, FirstName => 'Jane', LastName => 'Doe', Email => 'Jane.Doe@hotmail.com'}, "Fetch user details in scalar context");

{
	my %got = $db->FetchUserDetails(2);
	is_deeply( \%got, {Id => 2, FirstName => 'Jane', LastName => 'Doe', Email => 'Jane.Doe@hotmail.com'}, "Fetch user details in list context");
}

is_deeply( scalar($db->FetchUserDetails(-Id => 1)), {Id => 1, FirstName => 'John', LastName => 'Doe', Email => 'John.Doe@hotmail.com'}, "Fetch user details in scalar context with named args");
is_deeply( scalar($db->FetchUserDetails(-Id => 3)), {Id => 3, FirstName => 'Ken', LastName => 'Plastic', Email => undef}, "Fetch user details in scalar context with named args wo Email");

{
	my $got = $db->FetchUsers();
	my $good = [
		['4','Barbie','Blond',undef],
		['2','Jane','Doe','Jane.Doe@hotmail.com'],
		['1','John','Doe','John.Doe@hotmail.com'],
		['5','Corrie','McDowel',undef],
		['3','Ken','Plastic',undef]
	];
	is_deeply($got, $good, "Fetch as array of arrays in scalar context");

	my @got = $db->FetchUsers();
	is_deeply( \@got, $good, "Fetch as array of arrays in list context");
}

{
	my $got = $db->FetchUsersWithNames();
#print Dumper($got);
	my $good = [
		{'FirstName' => 'Barbie','Id' => '4','LastName' => 'Blond','Email' => undef},
		{'FirstName' => 'Jane','Id' => '2','LastName' => 'Doe','Email' => 'Jane.Doe@hotmail.com'},
		{'FirstName' => 'John','Id' => '1','LastName' => 'Doe','Email' => 'John.Doe@hotmail.com'},
		{'FirstName' => 'Corrie','Id' => '5','LastName' => 'McDowel','Email' => undef},
		{'FirstName' => 'Ken','Id' => '3','LastName' => 'Plastic','Email' => undef}
	];
	is_deeply($got, $good, "Fetch as array of hashes in scalar context");

	my @got = $db->FetchUsersWithNames();
	is_deeply( \@got, $good, "Fetch as array of hashes in list context");
}

ok( $db->UpdateUser( -Id => 5, -Email => 'Corrie@shotmail.com', -FirstName => 'Corrie', -LastName => 'McDowel'), 'update a user');
is_deeply( scalar($db->FetchUserDetails(-Id => 5)), {Id => 5, FirstName => 'Corrie', LastName => 'McDowel', Email => 'Corrie@shotmail.com'}, "Fetch updated user details");

ok( $db->UpdateUser( -Id => 3, -Email => 'Ken@mattel.com'), 'update a user with defaults');
is_deeply( scalar($db->FetchUserDetails(-Id => 3)), {Id => 3, FirstName => 'Ken', LastName => 'Plastic', Email => 'Ken@mattel.com'}, "Fetch updated user details");

ok( $db->DeleteUser( -Id => 4), 'delete a user');
{
	my $got = $db->FetchUsers();
	my $good = [
		['2','Jane','Doe','Jane.Doe@hotmail.com'],
		['1','John','Doe','John.Doe@hotmail.com'],
		['5','Corrie','McDowel','Corrie@shotmail.com'],
		['3','Ken','Plastic','Ken@mattel.com']
	];
	is_deeply($got, $good, "Fetch updated users");
}

ok( $db->DeleteAllUsers(), "delete all users");
{
	my $got = $db->FetchUsers();
	is_deeply($got, [], "Fetch empty resultset");
}

# various returns
$db->DropTableUsers;
$db->CreateTableUsers_Autoincrement();
#$db->{_show_generated_code} = 1;
is( $db->InsertUserID('John', 'Doe', 'John.Doe@hotmail.com'), 1, "Inserted row ID");
#$db->{_show_generated_code} = 0;

is( $db->InsertUserID(-FirstName => 'Jane', -LastName => 'Doe', -Email => 'Jane.Doe@hotmail.com'), 2, "Inserted row ID with named params");


$db->InsertUserID('Ken', 'Plastic');
$db->InsertUserID(-FirstName => 'Barbie', -LastName => 'Blond');
$db->InsertUserID(-LastName => 'McDowel', -FirstName => 'Corrie');

is_deeply( scalar($db->FetchUserDetailsA(2)), ['2','Jane','Doe','Jane.Doe@hotmail.com'], "Fetch user details in scalar context");
is_deeply( scalar($db->FetchUserDetailsA(-Id => 3)), ['3','Ken','Plastic',undef], "Fetch user details in scalar context with named args wo Email");

{
	my $got = $db->FetchUsersA();
	my $good = [
		'4','Barbie','Blond',undef,
		'2','Jane','Doe','Jane.Doe@hotmail.com',
		'1','John','Doe','John.Doe@hotmail.com',
		'5','Corrie','McDowel',undef,
		'3','Ken','Plastic',undef
	];
	is_deeply($got, $good, "Fetch as array in scalar context");

	my @got = $db->FetchUsersA();
	is_deeply( \@got, $good, "Fetch as array of arrays in list context");
}

{
	my $sth = $db->FetchUsersHNDL();
	my $good = [
		['4','Barbie','Blond',undef],
		['2','Jane','Doe','Jane.Doe@hotmail.com'],
		['1','John','Doe','John.Doe@hotmail.com'],
		['5','Corrie','McDowel',undef],
		['3','Ken','Plastic',undef]
	];
	ok( $sth, "Fetch returning the statement" );

	while (my $row = $sth->fetchrow_arrayref) {
		is_deeply( $row, shift(@$good), "Fetch returning the statement (rows)" );
	}
}

{
	my $good = [
		'4: Barbie Blond <>',
		'2: Jane Doe <Jane.Doe@hotmail.com>',
		'1: John Doe <John.Doe@hotmail.com>',
		'5: Corrie McDowel <>',
		'3: Ken Plastic <>',
	];
	is_deeply( scalar($db->FetchUsersSA()), $good, "Fetch via a subroutine (ARRAY)" );
	my @got = $db->FetchUsersSA();
	is_deeply( \@got, $good, "Fetch via a subroutine (ARRAY) list context" );

	is_deeply( scalar($db->FetchUsersSRA()), $good, "Fetch via a subroutine (ARRAYREF)" );
	@got = $db->FetchUsersSRA();
	is_deeply( \@got, $good, "Fetch via a subroutine (ARRAYREF) list context" );

	is_deeply( scalar($db->FetchUsersSH()), $good, "Fetch via a subroutine (HASH)" );
	@got = $db->FetchUsersSH();
	is_deeply( \@got, $good, "Fetch via a subroutine (HASH) list context" );

	is_deeply( scalar($db->FetchUsersSRH()), $good, "Fetch via a subroutine (HASHREF)" );
	@got = $db->FetchUsersSRH();
	is_deeply( \@got, $good, "Fetch via a subroutine (HASHREF) list context" );
}

{
	my @good = (
		ClsA->new( 4, 'Barbie', 'Blond'),
		ClsRA->new( [2, 'Jane', 'Doe',  'Jane.Doe@hotmail.com']),
		ClsH->new( Id => 1, FirstName => 'John', LastName => 'Doe', Email => 'John.Doe@hotmail.com'),
		ClsRH->new( {Id => 5, FirstName => 'Corrie', LastName => 'McDowel', Email => undef} ),
		ClsA->new( 3, 'Ken', 'Plastic', undef),
	);

	is_deeply(
		[map $_->toString, @good],
		[
		'4: Barbie Blond <>',
		'2: Jane Doe <Jane.Doe@hotmail.com>',
		'1: John Doe <John.Doe@hotmail.com>',
		'5: Corrie McDowel <>',
		'3: Ken Plastic <>',
		],
		"all fake classes work"
	);

	is_deeply( scalar($db->FetchUsersOA()), \@good, "Fetch and create objects (ARRAY)" );
	my @got = $db->FetchUsersOA();
	is_deeply( \@got, \@good, "Fetch and create objects (ARRAY) list context" );

	is_deeply( scalar($db->FetchUsersORA()), \@good, "Fetch and create objects (ARRAYREF)" );
	@got = $db->FetchUsersORA();
	is_deeply( \@got, \@good, "Fetch and create objects (ARRAYREF) list context" );

	is_deeply( scalar($db->FetchUsersOH()), \@good, "Fetch and create objects (HASH)" );
	@got = $db->FetchUsersOH();
	is_deeply( \@got, \@good, "Fetch and create objects (HASH) list context" );

	is_deeply( scalar($db->FetchUsersORH()), \@good, "Fetch and create objects (HASHREF)" );
	@got = $db->FetchUsersORH();
	is_deeply( \@got, \@good, "Fetch and create objects (HASHREF) list context" );
}

#END {
#	close $fh if $fh;
#	$filename and unlink($filename) and diag("Dropped the database");
#}

} #of SKIP

exit;

package Cls;

sub toString {
	my $self = shift();
	return "$self->{id}: $self->{fname} $self->{lname} <$self->{email}>"
}

package ClsA;

sub new {
	my $class = shift();
	my ($id, $fname, $lname, $email) = @_;
	bless {id => $id, fname => $fname, lname => $lname, email => $email}, 'Cls';
}

package ClsRA;

sub new {
	my $class = shift();
	my ($id, $fname, $lname, $email) = @{$_[0]};
	bless {id => $id, fname => $fname, lname => $lname, email => $email}, 'Cls';
}

package ClsH;

sub new {
	my $class = shift();
	my %data = @_;
	bless {id => $data{Id}, fname => $data{FirstName}, lname => $data{LastName}, email => $data{Email}}, 'Cls';
}

package ClsRH;

sub new {
	my $class = shift();
	my ($data) = @_;
	bless {id => $data->{Id}, fname => $data->{FirstName}, lname => $data->{LastName}, email => $data->{Email}}, 'Cls';
}

