#!/usr/bin/env perl

# stripped-down version of Rose-DB-Object t/test-lib.pl

use strict;
use warnings;

use DateTime;
use Data::Dumper;
use DBIx::Simple;
use Data::Printer;
use LIMS::Validate;
use LIMS::Dispatch;
use LIMS::Local::Utils;
use DateTime::Format::Strptime;
use Test::WWW::Mechanize::CGIApp;
use Digest::SHA1 'sha1_base64';
#use LIMS::DB; # moved to 'require' in BEGIN block for Win32

# globals used in more than 1 method, or returned to test scripts:
our ($mech, $dbh, $dsn, $dbh_super, $dbix, $cfg, $default_userid,
    $default_password, $fh);

BEGIN {
    use LIMS::Local::Config;
    $cfg = LIMS::Local::Config->instance;

    # override some local settings:
    $cfg->{settings}->{offline} = 0; # or cannot login
    $cfg->{settings}->{pds_proxy} = undef; # prevent PDS lookup
    $cfg->{settings}->{have_request_audit} = 1;
    $cfg->{settings}->{have_gross_description} = 1;
    $cfg->{settings}->{lab_section_sample_type} = 1;
	$cfg->{settings}->{lab_user_login_page} = '/search'; # override dashboard
    # set flag for running env:
	$cfg->{settings}->{test_harness} = 1;

    my $home_dir = $cfg->{path_to_app_root};

    require "$home_dir/setup/lims.sql";
    require "$home_dir/t/test_data.pl";

    open $fh, '>' . "$home_dir/t/mech.htm" or die $!;

    $ENV{HARNESS_ACTIVE} ||= 1; # make sure it's switched on for LIMS::DB
    # set for Win32 tests otherwise triggers Rose::DB error (getpwuid not implemented):
    $ENV{ROSEDB_DEVINIT} = "$home_dir/config/rosedb_devinit_test.pl";
    # switch ON console debug (or use locally in scripts or command line):
    # $ENV{RDBO_DEBUG_ON} = 1;

    # needs to be loaded *after* ROSEDB_DEVINIT env var set:
    require LIMS::DB;

    my $db = LIMS::DB->new_or_cached;

    $dbh  = $db->retain_dbh or die LIMS::DB->error;
    $dsn  = $db->dsn; # warn Dumper $dsn;
    $dbix = DBIx::Simple->new($dbh);

    $mech = Test::WWW::Mechanize::CGIApp->new(app => 'LIMS::Dispatch');
}

BEGIN {
    # make sure HARNESS_ACTIVE env flag set for default_domain() in LIMS::DB - using default = test now so not req.
    $ENV{HARNESS_ACTIVE} || die 'HARNESS_ACTIVE flag not set - cannot continue'; # paranoia rules OK!!

    use vars qw($SQL_FOR_TABLE $FOREIGN_KEYS $TEST_DATA $HMRN_DATA); # from test_data.pl

	# make sure test_db exists:
	$dbh->do( 'CREATE DATABASE IF NOT EXISTS `lims_test`' ); # too late - already fails during connect

	# switch fk check off:
	$dbh->do( 'SET foreign_key_checks = 0' );

    foreach my $tbl ( keys %$SQL_FOR_TABLE ) { # print $tbl, "\n";
        my $sql = $SQL_FOR_TABLE->{$tbl}; # warn $sql;
		next if $sql =~ /DEFINER/; # not needed (or fatal) for tests

        local $dbh->{'RaiseError'} = 1;
        local $dbh->{'PrintError'} = 0;

		$dbh->do( qq!DROP TABLE IF EXISTS `$tbl`! );
		$dbh->do( $sql );
    }
	# switch fk check back on:
	$dbh->do( 'SET foreign_key_checks = 1' );

    $default_userid   = 'admin_fname.admin_lname';
    $default_password = 'adm1n';

    foreach my $t( keys %$TEST_DATA ) { # warn $t, "\n";
        my $table  = $t,
        my $fields = $TEST_DATA->{$t}->{fields};
        my $values = $TEST_DATA->{$t}->{values};

        foreach my $data_set (@$values) { # warn $set, "\n";
            my $i = 0;
            # map field_name to its value:
            my %data = map { $fields->[$i++] => $_ } @$data_set; # warn Dumper \%data;

            $dbix->insert($t, \%data);
        }
    }
=begin # no point if can't use FK's:
	# create fk's:
	foreach my $fk ( sort keys %$FOREIGN_KEYS ) { # print $FOREIGN_KEYS->{$fk};
        $dbh->do( $FOREIGN_KEYS->{$fk} ); # print " .. OK\n";
    }
=cut
}

# messaging system -------------------------------------------------------------
# returns dfv messages ($messages->{dfv_msgs}->{$foo}):
sub get_dfv_message {
	my $class = shift;
	return $cfg->{msg}->{dfv_msgs}->{$class};
}

# returns not dfv mmeeages ($messages->{$foo}):
sub get_messages {
    my $class = shift;
    return $cfg->{msg}->{$class};
}

sub get_test_data {
	return $TEST_DATA;
}

# return dfv error, formatted as specified in $cfg->{dfv_defaults}->{msg}->{format}
# (for dfv messages constructed from $cfg->{msgs}->{dfv_msgs})
# internal & external (*.t scripts) method:
sub dfv_format {
	my $msg = shift;

	my $template = $cfg->{dfv_defaults}->{msgs}->{format};
	my $string = get_dfv_message($msg);

	# something like '<span class="dfv_errors">&#171; %s</span>', 'foo':
	return sprintf $template, $string;
}

# return dfv error, formatted as specified in $cfg->{dfv_defaults}->{msg}->{format}:
# (for default messages constructed from $cfg->{dfv_defaults}->{msgs})
# internal-only method:
sub _format_dfv_string_default {
	my $msg = shift;

	my $dfv_msgs = $cfg->{dfv_defaults}->{msgs};

	# something like '<span class="dfv_errors">&#171; %s</span>', 'foo':
	return sprintf $dfv_msgs->{format}, $dfv_msgs->{$msg};
}
#------------------------------------------------------------------------------

sub get_dbh { return $dbh; }

sub get_dbh_super { return _admin_user_dbh(); }

sub get_dbix { return $dbix; }

sub get_config { return $cfg; }

sub get_last_insert_id {
	my $table = shift;

	# only works if it was a DBIx::Simple action:
#	my $last_insert_id = $dbix->last_insert_id(undef, undef, $table, 'id');
	my $last_insert_id = $dbix->query('select max(id) from '.$table)->list;
	return $last_insert_id;
}

sub get_mech {
    return $mech;
}

sub get_yaml {
	my $filename  = shift;
	my $wantarray = shift; # optional flag to return yaml array not scalar (hashref)

    my %args = (
        yaml_dir => $cfg->{settings}->{yaml_dir},
        app_root => $cfg->{path_to_app_root},
        filename => $filename,
    ); # warn Dumper \%args;

	if ($wantarray) {
		my @yaml = LIMS::Local::Utils::get_yaml(\%args); # warn Dumper @yaml;
		return @yaml; # but will actually be arrayref
	}
	else {
		my $yaml = LIMS::Local::Utils::get_yaml(\%args);
		return $yaml;
	}
}

sub get_formatter {
    return DateTime::Format::Strptime->new(pattern => '%d.%b.%Y');
}

sub time_now { # $now->dmy, ' ', $now->hms;
    LIMS::Local::Utils::date_and_time_now;
}

sub drop_tables {
    my $tables = shift; # arrayref

    my $dbh = get_dbh() or die 'no database handle recieved from get_dbh';

    # Drop existing tables, ignoring errors
    {
        local $dbh->{'RaiseError'} = 0;
        local $dbh->{'PrintError'} = 0;

        foreach (@$tables) {
            $dbh->do("DROP TABLE $_"); # or warn $dbh->errstr;
        };
    }
}

# return LIMS::Validate object, may need to add new models as required see
# LIMS::Base::validation_models() for list
sub get_validation_profiles {
    my $o = LIMS::Validate->new(
        models => { # expects hmrn_param_constraints coderef but doesn't use it:
            hmrn_param_constraints => sub { {} },
        },
    );
    return $o;
}

sub drop_and_recreate {
    my $table = shift; # warn $table;

    my $dbh = get_dbh() or die 'no database handle recieved from get_dbh';

=begin # no point if can't use FK's:
	# delete all fk's:
	foreach my $fk ( sort keys %$FOREIGN_KEYS ) {
		my ($tbl) = $fk =~ /fk_(.*)/; # print Dumper $tbl;

		my (@fks) = $FOREIGN_KEYS->{$fk} =~ /(\w+_ibfk_\d)/g; # print Dumper \@fks;

		map { # print qq!ALTER TABLE `$tbl` DROP FOREIGN KEY `$_`!;
			$dbh->do( qq!ALTER TABLE `$tbl` DROP FOREIGN KEY `$_`! ); # print " .. OK\n";
		} @fks;
    }
=cut
    $dbh->do( "DROP TABLE $table" );
    $dbh->do( $SQL_FOR_TABLE->{$table} );

=begin # no point if can't use FK's:
	# re-create all fk's:
	foreach my $fk ( sort keys %$FOREIGN_KEYS ) {  print $FOREIGN_KEYS->{$fk};
        $dbh->do( $FOREIGN_KEYS->{$fk} );  print " .. OK\n";
    }
=cut
}

sub do_login {
    my $userid = shift || $default_userid;
    my $passwd = shift || $default_password;

    my $response = $mech->get_ok('/');                       # print_and_exit();

    # ok($response->header('Set-Cookie'), 'has cookie header');

    like( $mech->cookie_jar->as_string(), qr/CGISESSID/,  'cookie was accepted' );

    # confirm login box loaded:
    $mech->content_contains(
        'Please enter your login details',
        'login box loaded',
    );
    ### select 1st form:
    $mech->form_name('login_form');

    # login:
    $mech->submit_form(
        fields => {
            authen_username => $userid,
            authen_password => $passwd,
        }
    );

	my $user_map = get_user_map($userid); # warn Dumper $user_map;

    # confirm logged in:
	$mech->has_tag_like(
		span => qr($user_map->{first_name} $user_map->{last_name})i,
        'user logged in successfully',
	); # print_and_exit();
}

sub create_guest_user {
	my $args = shift;

	my $first_name = $args->{fname} || 'a';
	my $last_name  = $args->{lname} || 'guest';

	my $user = {
		id => 2, # 2nd record in users table
		username => 'guest',
		last_name => $last_name,
		first_name => $first_name,
		password => 'qLDknwhYTQg38TFB2kQEtgu1fpY', # guessed
		user_location_id => 2,
		designation => 'test user - guest',
		email => 'guest@example.com',
		group_id => 2, # guest
		active => 'yes',
	};
	# create external location:
	$dbix->insert('user_locations',
		{ location_name => 'Zoo', region_code => 'XYZ'});
	$dbix->insert('users', $user);
}

sub get_user_map {
    my $userid = shift; # warn Dumper $userid;

    my ($fname,$lname) = split '\.', $userid; # warn Dumper [$fname,$lname];

	my $dbix = get_dbix();
    my $sql = q!select first_name, last_name, username from users where
        first_name = ? and last_name = ?!;
	return $dbix->query($sql, $fname, $lname)->hash;
}

sub do_hmrn_data {
    # clear existing & copy data from hmrn:
    my $dbh = $dbix->dbh;
    $dbh->do('set foreign_key_checks = 0');
    while ( my ($tbl, $col_ref) = each %$HMRN_DATA ) { # warn Dumper [$tbl, $col_ref];
        # my @cols = $dbix->select('hmrn.'.$tbl, $col_ref)->arrays; p \@cols;
        my @cols = $col_ref eq '*'
            ? get_cols_from_meta("hmrn.$tbl")
            : join ',', @$col_ref;
        $dbh->do('TRUNCATE TABLE hmrn_test.'.$tbl);
        $dbh->do(qq!INSERT INTO hmrn_test.$tbl (@cols)
            SELECT @cols FROM hmrn.$tbl!);
    }
    $dbh->do('set foreign_key_checks = 1');
}

sub get_cols_from_meta {
    my $tbl = shift;
	my $t = $dbix->query("show columns from $tbl")->hashes; # warn Dumper $t;
	my @cols = map $_->{field}, @$t; # warn Dumper \@cols;
    return join ',', @cols;
}

sub is_spell_check_required {
    my $cfg = get_config();
    return $cfg->{settings}->{require_spell_check} eq 'yes';
}

sub test_missing_required {
	my $data = shift; # use Data::Dumper; warn 'here'; warn Dumper $data;
	my $form_name = shift; # optional - used for multi-form pages

    # test each required field:
    foreach my $field ( keys %$data ) { #  warn 'here'; warn $field;
        # create temp hash with one field missing:
        my %tmp = %$data; # clone %data
        $tmp{$field} = undef; # warn 'here'; warn Dumper \%tmp;

        # jump to correct form:
		if ($form_name) {
			$mech->form_name($form_name);
		}
        $mech->submit_form( fields => \%tmp );           # print_content(); exit;

        # check we have dfv error:
        has_dfv_errors();
        has_missing($field);
    }
}

sub has_dfv_errors {
    $mech->content_contains(
        get_messages('dfv_errors'),
        'OK: form validation failed',
    );
}

sub lacks_dfv_errors {
	my $msg = shift || 'form validation passed';

    $mech->content_lacks(
        get_messages('dfv_errors'),
        "OK: $msg",
    );
}

sub has_formvalidator_error {
    my $str = shift;

    $mech->content_contains(
        qq!<li>$str</li>!,
        'OK: expected field error detected'
    );
}

sub lacks_formvalidator_error {
    my $str = shift;

    $mech->content_lacks(
        qq!<li>$str</li>!,
        'OK: field error absent'
    );
}

# constructed from default string $cfg->{dfv_defaults}->{msgs}->{missing}:
sub has_missing {
    my $field = shift || 'field';
    $mech->content_contains(
		_format_dfv_string_default('missing'),
        "OK: missing $field detected",
    );
}

# constructed from default string $cfg->{dfv_defaults}->{msgs}->{missing}:
sub lacks_missing {
    $mech->content_lacks(
		_format_dfv_string_default('missing'),
        'OK: missing field(s) not detected',
    );
}

# constructed from default string $cfg->{dfv_defaults}->{msgs}->{invalid}:
sub has_invalid {
	my $msg = shift || 'invalid entry detected';

    $mech->content_contains(
		_format_dfv_string_default('invalid'),
        "OK: $msg",
    );
}

# constructed from default string $cfg->{dfv_defaults}->{msgs}->{invalid}:
sub lacks_invalid {
	my $msg = shift || 'invalid entry not detected';

    $mech->content_lacks(
		_format_dfv_string_default('invalid'),
        "OK: $msg",
    );
}

# constructed from custom string $cfg->{msg}->{dfv_messages}->{not_unique}:
sub has_duplicate {
	$mech->content_contains(
		dfv_format('not_unique'),
		'OK: duplicate entry detected',
	);
}

# constructed from custom string $cfg->{msg}->{dfv_messages}->{not_unique}:
sub lacks_duplicate {
	$mech->content_lacks(
		dfv_format('not_unique'),
		'OK: duplicate entry not detected',
	);
}

sub print_content {
	print $fh $mech->content;
}

sub print_and_exit {
	print $fh $mech->content; exit;
}

sub get_digest {
    my $pwd = shift;

    return Digest::SHA1::sha1_base64($pwd);
}

sub retrieve_all_records {
    my ($form_name, $field_name) = @_;

    $mech->form_name($form_name);
    $mech->field($field_name => '%');
    $mech->submit();
}

sub do_logout {
    $mech->follow_link_ok(
        # {n => 8}, "Logout $_ via eighth link on page",
        { url_regex => qr/logout/i, },
        'logout using LogOut link on page',
    );

    # confirm login box loaded:
    $mech->content_contains(
        'Please enter your login details',
        'login box re-loaded',
    );
}

sub mysql_supports_innodb {
  eval {
    CLEAR: {
      local $dbh->{'RaiseError'} = 0;
      local $dbh->{'PrintError'} = 0;
      $dbh->do('DROP TABLE rdbo_innodb_test');
    }

    $dbh->do( q!CREATE TABLE rdbo_innodb_test( id INTEGER PRIMARY KEY )
		ENGINE=InnoDB! );

    # MySQL will silently ignore the "TYPE=InnoDB" part and create
    # a MyISAM table instead.  MySQL is evil!  Now we have to manually
    # check to make sure an InnoDB table was really created.
    my $db_name = 'lims_test';
    my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?");
    $sth->execute('rdbo_innodb_test');
    my $info = $sth->fetchrow_hashref;

	my $str = $info->{Type} || $info->{Engine};
    unless ( $str && lc $str eq 'innodb') {
      die "Missing InnoDB support";
    }

    $dbh->do('DROP TABLE rdbo_innodb_test');
  };

  if ($@) {
    warn $@  unless($@ =~ /Missing InnoDB support/);
    return 0;
  }

  return 1;
}

# SUPER privileges are needed to create triggers after MySQL v5.0.x (or use less
# safe option in my.ini - SET GLOBAL log_bin_trust_function_creators = 1):
sub _admin_user_dbh {
    my $settings = $cfg->{settings};

    my $admin_user = $settings->{admin_db_user};
    my $admin_pwd  = $settings->{admin_db_pwd};

    $dbh_super = DBIx::Simple->connect( $dsn, $admin_user, $admin_pwd, {} );
    return $dbh_super->dbh;
}

END {
    foreach my $t ( keys %$SQL_FOR_TABLE )  {
        #$dbh->do("DROP TABLE $t");
    }

    $dbh->disconnect;
    if ($dbh_super) { $dbh_super->disconnect } # only exists on call from triggers.t
}

1;