#!/usr/bin/env perl

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

use strict;
use warnings;

use Data::Dumper;
use DBIx::Simple;
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, $dbix, $cfg, $default_userid, $default_password, $fh);

BEGIN {
	use LIMS::Local::Config;
	$cfg = LIMS::Local::Config->instance;
	
    # override some local settings:
    $cfg->{settings}->{have_request_audit} = 1;
    $cfg->{settings}->{lab_section_sample_type} = 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/logs/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";
    # 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; # use Data::Dumper; warn Dumper $db->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); # from test_data.pl

	# make sure test_db exists:
	$dbh->do( 'CREATE DATABASE IF NOT EXISTS `lims_test`' ); # too late - already fails during connect
	
    foreach my $tbl ( keys %$SQL_FOR_TABLE ) { # print $tbl, "\n";
		next if $tbl =~ /^_/; # not needed for tests
		
        local $dbh->{'RaiseError'} = 1; local $dbh->{'PrintError'} = 0;
		
		$dbh->do( qq!DROP TABLE IF EXISTS `$tbl`! );
		
        my $sql = $SQL_FOR_TABLE->{$tbl}; # warn $sql;
		$dbh->do( $sql );
    }

    $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_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_formatter {
    return DateTime::Format::Strptime->new(pattern => '%d.%b.%Y');
}

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;
        };
    }
}

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('/'); 

    # 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 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 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();
        
        # check we have dfv error:
        has_dfv_errors();
        has_missing();
    }                                                         
}

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 {
    $mech->content_contains(
		_format_dfv_string_default('missing'),
        'OK: missing field(s) 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 ) TYPE=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;

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

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

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

  return 1;
}

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

    $dbh->disconnect;
}

1;