package DB::Test;
use strict;
use warnings;
use SQL::Abstract;
use Try::Tiny;
use DBD::SQLite::Constants qw/:file_open/;
use File::Temp qw/tempfile/;
use Hash::Util::FieldHash qw/fieldhash/;
use ECS::Fake::Site;
fieldhash my %dbh;
my %fh;
my %fn;

=pod

=head1 NAME

DB::Test - Test Helper for database testing

=head1 DESCRIPTION

DB::Test is a test class intended to be subclassed so that you can provide your own table definitions.  

Create a subclass of this package, and add functions matching table names returning CREATE TABLE statements in SQLite-compatible SQL.

=head1 SYNOPSIS

	package DB::Test::Product;
	use parent 'DB::Test';

	sub product {
		my ($class, $schema) = @_;
		$schema ||= 'main';
		"CREATE TABLE $schema.product (
			productID INTEGER PRIMARY KEY,
			description TEXT NOT NULL
		)"
	}

	1;

	# elsewhere
	use DB::Test::Product;

	my $dbh = db_connect;
	DB::Test::Product->add_table_in_schema($dbh, estore => 'product');
	# insert a test product
	DB::Test::Product->add_row( $dbh, 'estore.product' => +{ productID => 125, description => 'Test Product' } ); 
	# find a product
	my $rows = DB::Test::Product->find( $dbh, product => +{ productID => 124 } ); 
	
=head1 CLASS METHODS

=head2 add_function( $dbh C<Dbh>, $func_name C<Str>, $argc C<Int>, $code C<CODE> )

Adds a function $func_name to the database $dbh (assumes SQLite), with the body in the $code.  
The function accepts $argc parameters (a value of -1 for $argc indicates any number of parameters)

=cut

sub add_function {
	my $class = shift;
	my ($dbh, $func_name, $argc, $sub) = @_; 
	return $dbh->sqlite_create_function( $func_name, $argc, $sub );
}

=pod 

=head2 add_schema($dbh C<Dbh>, $schema_name C<Str>, $filename C<Optional FileName>, $readOnly CC<Optional Bool> )

Adds a schema (by default, C<:memory:> database) to the current database.  If F<$filename> is provided,
use that file instead of memory.   If C<$readonly> is specified and a true value, then the schema will
be attacked read-only.

=cut

sub add_schema {
	my $class = shift;
	my ($dbh, $schema, $filename, $readonly) = @_;
	return unless $schema;
	my $dbfile = defined $filename ? $filename : ":memory:";
	$dbfile = (sprintf 'file:%s?mode=%s', $filename,
		$readonly ? 'ro' : 'rwc') if $filename;
	$dbh->do(qq{ATTACH DATABASE '$dbfile' AS $schema});
}

=pod

=head2 add_table( $dbh C<Dbh>, $table_name C<Str> )

Add a table to the database pointed to by $dbh

=cut

sub add_table {
	my $class = shift;
	my ($dbh, $table) = @_;
	return unless $table;
	return unless my $table_sql = $class->$table;
	my $sth = $dbh->prepare( $table_sql );
	return $sth->execute;
}

=pod

=head2 add_table_in_schema( $dbh C<Dbh>, $schema_name C<Str>, $table_name C<Str> )

Add a table to the database pointed to by $dbh in the schema $schema.   The table function
will need to handle an optional C<schema> parameter. 

=cut

sub add_table_in_schema {
	my $class = shift;
	my ($dbh, $schema, $table) = @_;
	return unless $table;
	return unless my $table_sql = $class->$table( $schema );
	my $sth = $dbh->prepare( $table_sql );
	return $sth->execute;
}

=pod

=head2 add_trigger_in_schema( $dbh C<Dbh>, $schema_name C<Str>, $trigger_name C<Str> )

Adds a trigger (or view) in the specified schema.   Expects to find a function named C<trigger_$trigger_name>
in the current namespace.

=cut

sub add_trigger_in_schema {
	my $class = shift;
	my ($dbh, $schema, $trigger) = @_;
	return unless $trigger;
	my $trigger_sub = "trigger_$trigger";
	return unless my $trigger_sql = $class->$trigger_sub( $schema );
	my $sth = $dbh->prepare( $trigger_sql );
	return $sth->execute;
}

=pod

=head2 setup_db() 

Sets up test schema (tms, estore), for use in estore readwrite, estore readonly, tms readwrite and tms readonly
databases.  Returns prebuilt estore_dbh, estore_dbhr, tms_dbh, tms_dbhr.  Should be called on subclasses, will
call init_db on the subclass. 

=cut

sub setup_db {
	# create tables
	# estore, need estore schema first
	my $class = shift || __PACKAGE__;
	my $opt = { sqlite_open_flags => SQLITE_OPEN_URI, sqlite_see_if_its_a_number => 1 };
	my $estore_dbh  = DBI->connect("dbi:SQLite:dbname=:memory:;name=estore_dbh","","", $opt);
	my $estore_dbhr = DBI->connect("dbi:SQLite:dbname=:memory:;name=estore_dbhr","","", $opt);
	my $tms_dbh  = DBI->connect("dbi:SQLite:dbname=:memory:;name=tms_dbh","","", $opt);
	my $tms_dbhr = DBI->connect("dbi:SQLite:dbname=:memory:;name=tms_dbhr","","", $opt);
	$class->reset_db;
	for my $dbh ($estore_dbh, $estore_dbhr) {
		my $readonly = $dbh == $estore_dbhr ? 1 : 0;
		$class->init_db( $dbh, 'estore', $readonly );
		$class->init_db( $dbh, 'tms', $readonly );
	}
	for my $dbh ($tms_dbh, $tms_dbhr) {
		my $readonly = $dbh == $tms_dbhr ? 1 : 0;
		$class->init_db( $dbh, 'tms', $readonly );
		$class->init_db( $dbh, 'estore', $readonly );
	}

	ECS::Fake::Site::build_fake_sites( $estore_dbh, $estore_dbhr, $tms_dbh, $tms_dbhr);
	return ($estore_dbh, $estore_dbhr, $tms_dbh, $tms_dbhr);
}

=head2 init_db( $dbh <Dbh> ) 

Intended to be called in subclasses, sets up the required tables and functions for the specific database under test

By default adds no tables, and adds the following functions

=over

=item * CONCAT( val1, val2, ... )

Combines the string values passed in into a single string

=item * SUBSTRING_INDEX( string, substring, count ) 

Finds substring in string, and returns either the portion of C<string> before the match (if count is positive)
or the portion of the string after (if count is negative)

=item * NOW() 

Returns the current date and time

=item * IF(condition, ifTrue, ifFalse)

Evaluates a condition, and returns the ifTrue value if the condition is true, otherwise the isFalse value

=back

=cut

sub func_now {
	scalar localtime( time );
}
sub func_if {
	my ($if, $then, $else) = @_;
	return $if ? $then : $else;
}

sub hook_prepare {
	# replace mysql specific ON DUPLICATE KEY UPDATE with
	# sqlite specific ON CONFLICT DO 
	# also strip prefixes on update
	my ($dbh, $query, $attrs, @rest) = @_;
	return if $DB::Test::in_callback; 
	local $DB::Test::in_callback = 1;
	$query =~ s/ON\s+DUPLICATE\s+KEY\s+UPDATE\s+/ON CONFLICT DO UPDATE SET /ism;
	$query =~ s/VALUES\(\s*(\w+)\s*\)/excluded.$1/gsm;
	undef $_;
	@_ = ($dbh, $query, $attrs, @rest);
	return $dbh->prepare( $query, $attrs, @rest );
}
sub init_db {
	my $class = shift;
	my ($dbh, $schema, $readonly) = @_;
	$schema ||= 'main';

	$class->add_function( $dbh, CONCAT => (-1, sub {
		join("", @_);
	}));
	$class->add_function( $dbh, SUBSTRING_INDEX => (3, sub {
		# only handle positive/negative, ignore actual count
		my ($str, $substr, $count) = @_;
		my $pos = index( $str, $substr );
		return $str if $pos == -1; # no match
		return 
			$count > 0 ? substr( $str, 0, $pos ) :
			$count < 0 ? substr( $str, $pos+1 ) :
			$str;
	}));
	# add function NOW
	$class->add_function( $dbh, 'NOW', 0, \&func_now );
	# add function IF
	$class->add_function( $dbh, 'IF', 3, \&func_if );
	$dbh->{Callbacks} = { prepare => \&hook_prepare };

	if ($schema ne 'main') { 
		unless ($fh{ $schema }) {
			($fh{$schema}, $fn{$schema}) = tempfile("db-$schema-XXXXXXXX",
				SUFFIX => '.sqlite',
				TMPDIR => 1,
				UNLINK => 1,
				EXLOCK => 0,
			);
		}
		$class->add_schema( $dbh, $schema, $fn{$schema}, $readonly );
	}
	if ($readonly || $dbh{$dbh}++) {
		return
	} else {
		return 1
	}
}

=head2 reset_db()

Clear any schemas, schema files, database handles that may be open, use at the beginning 
of the test before making any changes

=cut

sub reset_db {
	%fh = ();
	unlink values %fn if %fn;
	%fn = ();
}
=pod

=head2 add_row( $dbh C<Dbh>, $table C<Str>, $row_data C<HashRef> )

Adds a record (from $row_data) to $table (optionally schema qualified) in the database pointed to by $dbh

=cut

sub add_row {
	my $class = shift;
	my ($dbh, $table, $row) = @_;
	my $schema;
	return unless $row;
	($table, $schema) = reverse split /\./, $table;
	return unless $class->can($table);
	my $sqla = SQL::Abstract->new;
	$table = join '.', grep defined, $schema, $table;
	my ($sql, @binds) = $sqla->insert( $table, $row );
	my $sth = $dbh->prepare( $sql ); 
	return $sth->execute( @binds );
}

=pod

=head2 find( $dbh C<Dbh>, $table C<Str>, $fields C<SQL::Abstraxt::FIELDS>, $where C<SQL::Abstract::WHERE>, $order C<SQL::Abstract::ORDER_BY> )

Finds rows in table $table in database $dbh (table can be qualified with a schema, f.e. C<estore.product>, based on the $where and $order (using SQL::Abstract syntax)

=cut

sub find {
	my $class = shift;
	my ($dbh, $table, $fields, $where, $order) = @_;
	my $schema;
	return unless $table;
	($table, $schema) = reverse split /\./, $table;
	return unless $class->can($table);
	my $sqla = SQL::Abstract->new;
	$table = join '.', grep defined, $schema, $table;
	my ($sql, @binds) = $sqla->select( $table, $fields, $where, $order );
	return $dbh->selectall_arrayref( $sql, { Slice => {} }, @binds ); 
}

=pod

=head2 update( $dbh C<Dbh>, $table C<Str>, $field_values C<SQL::Abstraxt::FIELDVALS>, $where C<SQL::Abstract::WHERE> )

Updates field values $field_values in table $table in database $dbh, based on $where

=cut

sub update {
    my $class = shift;
    my ($dbh, $table, $field_values, $where) = @_;
    return unless $table;
    return unless $field_values;
    my ($sql, @binds) = SQL::Abstract->new->update( $table, $field_values, $where );
    my $sth = $dbh->prepare( $sql );
    return $sth->execute( @binds );
}
sub site {
	"CREATE TABLE site (
		siteID  INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
		name VARCHAR NULL,
		siteName NULL,
		domain NULL,
		phone NULL
	)"
}

=pod

=head2 populate( $dbh, $table ) 

Populates table $table with data from the L<data> function.

Returns the number of rows added.


=cut

sub populate {
	my $class = shift;
	my ($dbh, $table) = @_;
	return unless $table;
	my $rows = $class->data($table);
	for my $row (@$rows) {
		$class->add_row( $dbh, $table => $row );
	}
	return scalar @$rows;
}

=pod

=head2 data( $table )

Function called by L<populate> for data to populate, calls the L<_data> function (which should be 
implemented in subclasses), which returns an HoAoH of table to data row records.   Returns the AoH
specific to $table.

=cut

sub data {
	my $class = shift;
	my ($table) = @_;
	return [] unless $table;
	my $data = $class->_data();
	return $data->{$table} || [];
}

sub _data {
	return {};
}

1;