#!/usr/bin/perl -w

use strict;

#use CGI::Test;
use Test::More qw(no_plan);
use Test::WWW::Mechanize::CGIApp;
use lib "/Users/gwg/go/scratch/tools/";
use Carp ();
$SIG{__WARN__} = \&Carp::cluck;
$SIG{__DIE__} = \&Carp::confess;

$ENV{TMPL_VERBOSE} = 1;

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

use_ok( 'GO::MsgLite' );

my $installation_dir = '/Users/gwg/go/scratch/tools/';  # alter as necessary
my $mech = Test::WWW::Mechanize::CGIApp->new;

run_tests($mech);

exit(0);

sub run_tests {

	# prerequisites
	my @list = qw( GO::Tool::GenericGoTool
	CGI::Carp
	Data::FormValidator::Constraints
	GO::Object::Generic
	GO::TestSet
	GO::Utilities
	GO::GeneralPurposeParser
	URI::Escape);
	
	foreach (@list)
	{	use_ok($_);
	}

	# specifics
	my @list_2 = qw(
		GO::Tool::AddTool
		GO::Tool::BiblioTool
		GO::Tool::ReferencesTool
		GO::Tool::ToolsTool
		GO::Tool::XrefsTool

		GO::Object::Reference
		GO::Object::Xref
		GO::Object::XrefAbbr
		GO::Object::Tool
		GO::Object::Developer
		GO::Object::ToolPreview
	);

	## OK, let's start with the References and Xrefs tools.
	## Hopefully they will be easy to test!

	foreach (@list_2)
	{	use_ok($_);
#	{	eval { use $_; };
#		die "Could not 'use' specific module $_! $@\n" if $@;
	}

	my ($content, $parser, $parser_args, $html_display); # initialise these now...

=cut

	## let's see if we can parse these files without an error occurring...
	my $ref_db = "/Users/gwg/go/scratch/tools/test_data/GO.references";
#	$self->set_verbosity('superverbose');
	# get the parser ready for action
	$parser_args = {
		file => $ref_db,
		file_separator => "\n\n",
		inner_parser => {
			parser => 'multi_field_tag_value',
			return_record_as_object => 'GO::Object::Reference',
			check_input => 1,
			filter_field => qr/^[^!]/,
			filter_record => qr/^go_ref_id/ism,
		},
	};

	$parser = GO::GeneralPurposeParser->new;
	# read in the file
	my $arr = $parser->parse_from_file($parser_args);

	# tests 21 and 22
	# we should have one error and a ton of refs
	ok(scalar @$arr == 20, "found 20 GO refs");
	ok($parser->has_n_msgs == 1, "Parser has one error message");
#	print STDERR "results: ".Dumper($arr)."\n";

	
	# try first with a known incompatible value
	my $go_ref = 'GO_REF:000008';
	$parser_args->{inner_parser}{filter_record} = [ qr/^(go_ref|alt)_id: $go_ref\b/ism ];
	
	undef $arr;
	$arr = $parser->parse_from_file($parser_args);
	print STDERR "arr, looking for $go_ref: ".Dumper($arr);
	ok(! defined $arr, "Failing to find GO_REF:000008" );

	# known crap synonym
	$go_ref = 'GO_REF:000005';
	$parser_args->{inner_parser}{filter_record} = qr/^(go_ref|alt)_id: $go_ref\b/ism;
	undef $arr;
	$arr = $parser->parse_from_file($parser_args);
	print STDERR "arr, looking for $go_ref: ".Dumper($arr);
	ok(! defined $arr, "Cannot find $go_ref" );

	$parser_args->{inner_parser}{filter_record} = $go_ref;
	undef $arr;
	$arr = $parser->parse_from_file($parser_args);
	ok(! defined $arr, "$go_ref search fails" );

	# known compatible value
	$go_ref = 'GO_REF:0000008';
	my $different_args = {
		as_string => $go_ref,
		regexp => qr/^(go_ref|alt)_id: $go_ref\b/ism,
		regexp_in_arr => [ qr/^(go_ref|alt)_id: $go_ref\b/ism ],
		two_regexps_in_arr => [ qr/^go_ref_id: $go_ref/ism, qr/^alt_id: $go_ref/ism,],
		subroutine => sub { my $line = shift; return 1 if $line =~ /^(go_ref|alt)_id: $go_ref/ism; },
		boolean => { OR => [ { FN => sub { my $line = shift; return 1 if $line =~ /^go_ref_id: $go_ref/ism } }, { FN => sub { my $line = shift; return 1 if $line =~ /^alt_id: $go_ref/ism } } ] },
	};

	foreach my $input_type (keys %$different_args)
	{	
		$parser_args->{inner_parser}{filter_record} = $different_args->{$input_type};
		undef $arr;
		$arr = $parser->parse_from_file($parser_args);
		(my $input_txt = $input_type) =~ s/_/ /g;
		ok(scalar @$arr == 1 && $arr->[0]->go_ref_id eq $go_ref, "Searching for $go_ref, $input_txt");
		delete $parser_args->{inner_parser}{filter_record};
		
		$parser_args->{inner_parser}{if_then_record} = { if => $different_args->{$input_type} };
		undef $arr;
		$arr = $parser->parse_from_file($parser_args);
		ok(scalar @$arr == 1 && $arr->[0]->go_ref_id eq $go_ref, "Searching for $go_ref, $input_txt, if_then");
		delete $parser_args->{inner_parser}{if_then_record};
	}

	# known synonym
	$go_ref = 'GO_REF:0000005';
	$different_args = {
		as_string => $go_ref,
		regexp => qr/^(go_ref|alt)_id: $go_ref\b/ism,
		regexp_in_arr => [ qr/^(go_ref|alt)_id: $go_ref\b/ism ],
		two_regexps_in_arr => [ qr/^go_ref_id: $go_ref/ism, qr/^alt_id: $go_ref/ism,],
		subroutine => sub { my $line = shift; return 1 if $line =~ /^(go_ref|alt)_id: $go_ref/ism; },
		boolean => { OR => [ { FN => sub { my $line = shift; return 1 if $line =~ /^go_ref_id: $go_ref/ism } }, { FN => sub { my $line = shift; return 1 if $line =~ /^alt_id: $go_ref/ism } } ] },
	};

	foreach my $input_type (keys %$different_args)
	{	
		$parser_args->{inner_parser}{filter_record} = $different_args->{$input_type};
		undef $arr;
		$arr = $parser->parse_from_file($parser_args);
		(my $input_txt = $input_type) =~ s/_/ /g;
		ok(scalar @$arr == 1 && $arr->[0]->go_ref_id eq 'GO_REF:0000003', "Searching for $go_ref, alt ID for GO_REF:0000003, $input_txt");
		delete $parser_args->{inner_parser}{filter_record};
		
		$parser_args->{inner_parser}{if_then_record} = { if => $different_args->{$input_type} };
		undef $arr;
		$arr = $parser->parse_from_file($parser_args);
		ok(scalar @$arr == 1 && $arr->[0]->go_ref_id eq 'GO_REF:0000003', "Searching for $go_ref, alt ID for GO_REF:0000003, $input_txt, if_then");
		delete $parser_args->{inner_parser}{if_then_record};
	}

	$mech->app("GO::Tool::ReferencesTool");


	$mech->get_ok("", "Creating and getting GO::Tool::ReferencesTool");
	# check that the page has 20 GO refs
	my $content = $mech->content;
	my $count = ($content =~ s/(<h2 class="id">GO_REF:\d+<\/h2>)//g);
	print STDERR "list: ".Dumper($count);
	# t51
	ok($count == 20, "Found 20 GO REFs");
	
	# t52, t53: get a single GO REF
	$mech->get_ok("?id=GO_REF:0000008", "Get a single GO REF");
	$content = $mech->content;
	$count = ($content =~ s/(<h2 class="id">GO_REF:0000008<\/h2>)//g);
	ok( $count == 1, "Found GO_REF:0000008");

	# t54, t55: get a synonym
	$mech->get("?id=GO_REF:0000005");
	$mech->content_like(qr/alt id.*?GO_REF:0000005/i, "Got a GO ref; checking for the synonym");
	$content = $mech->content;
	$count = ($content =~ s/(<h2 class="id">GO_REF:0000003<\/h2>)//g);
	ok( $count == 1, "Found GO_REF:0000005 as an alias for GO_REF:0000003" );
=cut

	$html_display = {
		fatal_msg => '<div class="message fatal">',
		warning_msg => '<div class="message warning">',
		info_msg => '<div class="message info">',
		add_tool_title => 'Submit An Exciting Gene Ontology Tool',
		preview_tool_title => 'Preview Your Gene Ontology Tool Submission',
		submit_tool_title => 'GO Tool Submission Successful',
	};

=cut
#	$mech->app(
#		sub {
#			my $app = GO::Tool::ReferencesTool->new();
#			$app->set_verbosity('superverbose');
#			$app->run();
#		});

	# get an invalid ID
	$mech->get_ok("?id=GO_REF:000001", "t56: Getting an invalid ID");
	$mech->content_unlike(qr/<h2 class="id">GO_REF:\d+/i, "t57: Checking that no GO REFs were found");
	$mech->content_contains($html_display->{fatal_msg}, "t58: Checking for a fatal message");
	$mech->content_contains("invalid ID", "t59: Checking that the ID is invalid");

	## look for one valid, one invalid, etc..
	## do these tests for Xrefs Tool too.

=cut




	#============================#
	#  GO::Tool::AddTool tests!  #
	#============================#

	# let's get the spec of AddTool as it may well come in useful!
	my $save_file = $installation_dir."test_data/test_write_file.txt";
	my $tool = GO::Tool::AddTool->new(PARAMS => { save_file => $save_file });
	my $add_tool_spec = $tool->get_spec();

	$mech->app("GO::Tool::AddTool");
	$mech->get_ok("", "Got GO::Tool::AddTool with no args");
	$mech->title_is ( $html_display->{add_tool_title}, "Page title OK" );
	# get the content and save it for comparing to the next few results...
	my $blank_form_content = $mech->content;

	$mech->get_ok("?rm=tool_form");
	undef $content; $content = $mech->content;
	ok( $content eq $blank_form_content, "rm=tool_form, form content is blank" );

	$mech->get_ok("?rm=blurb");
	undef $content; $content = $mech->content;
	ok( $content eq $blank_form_content, "rm=blurb, form content is blank" );

	# get pages that should contain an error if there are no other params present
	for ('preview', 'submit')
	{	$mech->get_ok("?rm=$_");
		undef $content; $content = $mech->content;
		ok( ( $mech->content ne $blank_form_content && $mech->content_contains($html_display->{fatal_msg}) ), "rm=$_: form content NOT blank and fatal message shown");
	}
	
	# we're going to punish evil users who try to enter stuff through the URL by
	# deleting any data without a valid run mode present
	$mech->get_ok("?name=blobby");
	undef $content; $content = $mech->content;
	ok( $mech->content eq $blank_form_content, "name=blobby, form content is blank" );
	
	# ok, now let's submit some data
	$mech->submit_form_ok( { fields => { test_data => 'blah blah blah' } } , "Submitting crappy data with an rm" );
	undef $content; $content = $mech->content;
	
	ok ( ($mech->content ne $blank_form_content && $mech->content_contains($html_display->{fatal_msg}) ), "test_data = blah blah blah, form content is NOT blank as some data has been submitted" );
	## If this test fails, make sure that there is no form in the header of the page -
	## that messes things up

	my $spec_data;
	my $n_errors;
	foreach (keys %$add_tool_spec)
	{	if ($add_tool_spec->{$_}{default})
		{	$spec_data->{default}{$_} = $add_tool_spec->{$_}{default};
		}
		if ($add_tool_spec->{$_}{required})
		{	next if $add_tool_spec->{$_}{default};
			$spec_data->{reqd}{$_}++;
			## we should also have these as 'param_name: param is missing' in $content
			if ($content =~ /$_: param is OK/)
			{	$n_errors++;
			}
		}
	}
	ok( ! defined $n_errors, "ensuring all required keys are missing" );

	my $var_h;
	$var_h = { name => 'test tool' };
#	$mech->submit_form_ok( { form_name => 'add-tool-form', fields => $var_h }, "submitting form data" );
	$mech->submit_form_ok( { fields => $var_h }, "submitting form data" );
	## we should get an error page now.
	$mech->content_contains($html_display->{fatal_msg}, "Fatal message: name only");
	## check for the presence of errors in all the required fields except the name field.

	$mech->content_contains('name: param is OK', "Name parameter is OK");

	undef $n_errors;
	foreach (keys %{$spec_data->{reqd}})
	{	next if $_ eq 'name';
		$n_errors++ if $mech->content =~ /$_: param is OK/;
	}
	ok( ! defined $n_errors, "All required keys apart from name are missing. Phew!" );

	$mech->get("");
	#try another one...
	$var_h = {
		name => 'test tool', 
		url => 'http://www.here.com', 
		email => 'me@home.com', 
		developer => 'LBL, http://www.lbl.gov', 
		tool_type => 'is_online_tool', 
		feature => 'ont_view', 
		description => 'Test tool is a wikkid tool that does loads of cool stuff.',
#		rm => 'preview',
	};
	
	$mech->submit_form_ok( { fields => $var_h }, "Submitting OK data" );

	## we should NOT get an error page now.
	## The page should have a preview of the tool on it and the tool form in case
	## extra edits are wanted
	$mech->content_lacks('<div class="message fatal">', "Complete specification");
	$mech->title_is($html_display->{preview_tool_title}, "Page is the tool submission preview page");

	# check that all the required keys are present
	undef $n_errors;
	foreach (keys %{$spec_data->{reqd}})
	{	$n_errors++ if $mech->content !~ /$_: param is OK/;
	}
	ok( ! defined $n_errors, "All required keys are present. Phew!" );
	
	# check that we have the tool submission form
	my @forms = $mech->forms();
	ok( join(",", map { $_->attr('id') } @forms) == 'submit-tool-form,add-tool-form', "Got the tool submission form and the tool editing form");
	# check that the submission form has all the correct stuff in it
	## compare var_h to our hidden inputs
	
	is_deeply( compare_inputs_to_submitted_values({ mech => $mech, input => $var_h, spec => $spec_data }), $var_h , "Ensuring all params are present");

	# reset
	$mech->get("");
	# valid data set, two features
	$mech->form_name('add-tool-form');
	$var_h->{feature} = [ 'ont_view', 'annot_view' ];
	foreach (keys %$var_h)
	{	$mech->field($_, $var_h->{$_}); # unless $_ eq "feature";
	}
#	$mech->tick( 'feature', 'ont_view' );
#	$mech->tick( 'feature', 'annot_view');
	$mech->submit();

	# we should have the tool preview page with a valid result set here.
	$mech->title_is($html_display->{preview_tool_title}, "Page is the tool submission preview page");
	## let's see what the form inputs are this time

	# check that we have all our bits here
	is_deeply( compare_inputs_to_submitted_values({ mech => $mech, input => $var_h, spec => $spec_data }), $var_h , "Ensuring all params are present, TWO features ticked");
#	print STDERR "input_h: ".Dumper($input_h);

	# OK, let's submit our tool and see what happens...
	$mech->form_name('submit-tool-form');
	$mech->submit();

	$mech->title_is($html_display->{submit_tool_title}, "Successfully submitted the tool!");

	# reset
	$mech->get("");
	# valid data set, two names (should only have one)
	$mech->form_name('add-tool-form');
	$var_h->{name} = [ 'Tool 1', 'Tool 2' ];
	foreach (keys %$var_h)
	{	$mech->field($_, $var_h->{$_});
	}
	$mech->submit();

	print STDERR "url: ". make_url_from_hash($var_h)."\n";

	# we should have the tool preview page with a valid result set here.
	$mech->title_is($html_display->{preview_tool_title}, "Page is the tool submission preview page");
	## let's see what the form inputs are this time

	# only the first of the multiple values in $var_h->{name} will be used.
	$var_h->{name} = 'Tool 1';
	# check that we have all our bits here
	is_deeply( compare_inputs_to_submitted_values({ mech => $mech, input => $var_h, spec => $spec_data }), $var_h , "Ensuring all params are present, TWO name parameters supplied");

	## let's see what happens if we 
	
	
	
	# ok, let's try writing something
	# first ensure that we can write in test_data
	chmod (0755, $installation_dir."test_data") or warn "Could not change directory permissions: $!\n";
	
	my $msg = { file_name => $save_file, write_mode => 'write', string => 'This is a test message' };

	if (-e $msg->{file_name})
	{	# delete the file if it already exists
		unlink $msg->{file_name} or warn "Could not delete file ".$msg->{file_name}.": $!\n";
	}
	
	$tool->write_data_to_file($msg);
	# check the file is present and that all is well in the file.
	ok( -f $msg->{file_name} && -r $msg->{file_name}, "Checking whether file is in place and looking OK" );
	undef $content;
	SKIP: {
		my $open = 0;
		if( open( FILE, '<'.$msg->{file_name} ) )
		{	$open++;
		}

		skip "Could not open file: $!", 1 if ! defined $open;
		while (<FILE>)
		{	$content .= $_;
		}
		ok( $content =~ /$msg->{string}/, "File content contains string, as we hoped it might!" );
	}

	# ok, let's now try appending a file
	my $msg_2 = { file_name => $save_file, write_mode => 'append', string => 'This is also a test message' };
	$tool->write_data_to_file($msg_2);
	# check the file is present and that all is well in the file.
	ok( -f $msg_2->{file_name} && -r $msg_2->{file_name}, "Checking whether file is in place and looking OK again" );
	undef $content;
	SKIP: {
		my $open = 0;
		if( open( FILE, '<'.$msg_2->{file_name} ) )
		{	$open++;
		}

		skip "Could not open file: $!", 2 if ! defined $open;
		while (<FILE>)
		{	$content .= $_;
		}
		ok( $content =~ /$msg->{string}/, "File contains the first message...");
		ok( $content =~ /$msg_2->{string}/, "File contains the second message!");
	}
	
	$msg->{string} = "Here's a completely different message!";
	# Overwrite our existing file...
	$tool->write_data_to_file($msg);
	ok( -f $msg->{file_name} && -r $msg->{file_name}, "File is still in place and stil looking OK!" );
	undef $content;
	SKIP: {
		my $open = 0;
		if( open( FILE, '<'.$msg->{file_name} ) )
		{	$open++;
		}

		skip "Could not open file: $!", 2 if ! defined $open;
		while (<FILE>)
		{	$content .= $_;
		}
		ok( $content =~ /$msg->{string}/, "File contains the first message...");
		ok( $content !~ /$msg_2->{string}/, "File does not contain the second message.");
	}

	# ok, check it reports an error if we try to put a file somewhere that we're not supposed to.
	# make a subdirectory of test_data with some seriously unpermissive permissions
	mkdir( $installation_dir."test_data/extra_dir", 0444 );
	
	$msg->{file_name} = $installation_dir."test_data/extra_dir/test_file.txt";
	$tool->clear_all_msgs;
	$tool->write_data_to_file($msg);
	## we should find that the file couldn't be created.
	ok( ! -e $msg->{file_name}, "The file does not exist" );
	my $fatal = $tool->get_last_msg;
	# this should be a fatal message saying the file could not be written
	ok( $fatal->{MSG} eq "Could not open file ".$msg->{file_name}." for writing: Permission denied", "Permission to write file denied" );

	# now let's go through the tool submission process and
	# check that we can write a file at the other end of it.

	## first let's delete the save file if it exists
	if (-e $save_file)
	{	# delete the file if it already exists
		unlink $save_file or warn "Could not delete file $save_file: $!\n";
	}
	$tool->clear_all_msgs;

	$ENV{VERBOSE} = 1;
	$mech->get("");
	# insert tool data...
	$var_h = {
		name => 'My Test Tool', 
		url => 'http://www.here.com', 
		email => 'me@home.com', 
		developer => 'LBL, http://www.lbl.gov', 
		tool_type => ['is_online_tool', 'is_standalone_tool'],
		compatible_os => 'mac',
		feature => ['ont_view', 'godb', 'stat'],
		license => 'free_academic',
		description => 'My Test Tool is a wikkid tool that does loads of cool stuff.',
		go_data_used => ['term','def','synonym','tree',],
		is_open_source => 'false',
	};
	$mech->form_name('add-tool-form');
	foreach (keys %$var_h)
	{	$mech->field($_, $var_h->{$_}); # unless $_ eq "feature";
	}

	$mech->submit();
	# check that our entry was OK... it had better be!
	ok( ($mech->title_is($html_display->{preview_tool_title}) && $mech->content_lacks($html_display->{fatal_msg}) ), "Data successfully submitted for tool preview" );
	if (! $mech->title_is($html_display->{preview_tool_title}) )
	{	print STDERR $mech->content();
	
	
	}
	
	# submit this data!
	$mech->form_name('submit-tool-form');
	$mech->submit();
	
	ok( $mech->title_is($html_display->{submit_tool_title}), "Submitted form data successfully!" );
	# let's check that the file exists and that it contains the correct data
	SKIP: {
		skip "Could not find the save file: $!", 2 if ! -e $save_file;
		# happily we config'd AddTool to have its save file at $save_file.
		ok( (-r $save_file && ! -z $save_file), "File is readable AND has non-zero size!");
		# open it up and check the contents...
		my $open = 0;
		if( open( FILE, '<'.$msg->{file_name} ) )
		{	$open++;
		}

		skip "Could not open file: $!", 1 if ! defined $open;
		while (<FILE>)
		{	$content .= $_;
		}
		# check the content matches what we have in var_h
		print STDERR "content: ".$content."\n\n";
		ok( length $content > 0, "Contents have length greater than 0" );
#		ok( $content =~ /$msg->{string}/, "File contains the first message...");

	}
	

}

sub make_url_from_hash {
	my $var_h = shift;
	my $url = join("&", 
		map { 
			my $k = $_;
			if (!ref $var_h->{$k})
			{	$k . "=" . $var_h->{$k}
			}
			else
			{	join "&", map { $k ."=". $_ } @{$var_h->{$k}}
			}
		} keys %$var_h);
	return $url;
}

=cut

args: spec: the abbreviated spec
      mech: the mech
      input: what was used as input, as a hash
    [ use_form: the number of the form to use ]

=cut
sub compare_inputs_to_submitted_values {
	my $args = shift;
	if (! $args->{spec} || ! $args->{mech} || ! $args->{input} )
	{	print STDERR "missing an important parameter!\n" && return undef;
	}

	my $mech_thing = $args->{mech};
	my @form_arr = $mech_thing->forms();

	my $n = $args->{use_form} || 0;
	print STDERR "No forms found!\n" && return undef unless $form_arr[$n];
	
	my @input_arr = $form_arr[$n]->inputs();
	
	print STDERR "No inputs found!\n" && return undef unless scalar @input_arr > 0;
	
	my $input_h;
	foreach (@input_arr)
	{	next if $_->type eq 'submit';
		next if $_->name eq 'rm';
		if ($_->type eq 'hidden')
		{	if ($input_h->{$_->name})
			{	if (! ref $input_h->{$_->name} )
				{	$input_h->{$_->name} = [ $input_h->{$_->name}, $_->value ];
				}
				else
				{	push @{$input_h->{$_->name}}, $_->value;
				}
			}
			else
			{	$input_h->{$_->name} = $_->value;
			}
		}
	}

	foreach (keys %{$args->{spec}{default}})
	{	next if $args->{input}{$_};
		## delete the ones that weren't in our original query
		delete $input_h->{$_};
	}
	print STDERR "input_h: ".Dumper($input_h);
	return $input_h;
}