package GO::Tool::GenericGoTool;
use strict;
use lib 'go/scratch/tools';
use base qw(CGI::Application GO::MsgLite);

### Various modules required
use CGI::Application::Plugin::TT;
use Data::FormValidator::Filters qw(:filters);
use Data::FormValidator::Constraints qw(:closures);
use Data::FormValidator::Constraints::MethodsFactory qw(:num :bool);

#use CGI::Application::Plugin::ValidateRM (qw/check_rm/);

use Data::Dumper;

use CGI::Carp qw(fatalsToBrowser);

use URI::Escape;

use GO::TestSet qw(dfv_test);
use GO::Data_FormValidator;

#use Utilities qw(:all);
#use GO::Object;
#use GO::BiblioEntry;
#use GO::TestSet;
#use Utility::TSLParser;


our $template_include_paths = [ qw( /Users/gwg/go/scratch/tools/templates/ /Users/gwg/go/www/ ) ];


sub setup {
	my $self = shift;
	$self->error_mode('die_and_output_error');
}



# configure the template before we do anything else
sub cgiapp_init {
	my $self = shift;
	$self->tt_config(
		TEMPLATE_OPTIONS => {
			INCLUDE_PATH=> $template_include_paths,
			TRIM=>1,
		},
	);
}


# add the error list to the template
sub tt_pre_process {
	my $self = shift;
	my $template = shift;
	my $params = shift;

	$self->startme();

	if (! $params->{message_list} && $self->has_msgs )
	{	$params->{message_list} = $self->get_all_msgs('show_level');
	}

	$self->debugme("message list: ".Dumper( $params->{message_list} ) );
	
	return;
}

=head2 die_and_output_error

Die and output a simple error page explaining what happened.

input:	$self, $error (optional error object), $output_tmpl (optional template name)
output:	html page containing the error info

=cut

sub die_and_output_error {
	my $self = shift;
	my $error = shift;

	$self->startme();

	# add a generic warning message if there's no existing error
	if (! $error)
	{	$error = 'An unexpected error occurred' unless $self->has_msgs;
	}

	$self->debugme("got to here.", 1);

	$self->fatal_error($error) if $error;

	$self->debugme("did that bit, too");

	my $output_tmpl = shift || 'message';

	my $tmpl_vars;
	$tmpl_vars->{query_h} = $self->param('validated_query') if $self->param('validated_query');
#	$tmpl_vars->{message} = $self->get_all_msgs('show_level');

	return $self->tt_process( $output_tmpl . '.tmpl' , $tmpl_vars ) || die "Template toolkit messed up, the bastard!: ", $self->tt_obj->error(), "\n";

}


## the specification for the tool

=head2 _specification

This is the specification for the tool and its input parameters

input:	$self, $sub_type of spec
output:	the spec hash

The format is as follows:

param_name => {
	# param criteria
	test => dfv_test('test_name', @params)
	OR
	constraints =>
	[{	constraint => \&subroutine_ref,
		params => [ undef, $params_for_subroutine ],
	}],

	default => $default_value,
	list_values => [ $array_ref_of_values_for_form ],
	dependencies => {
		$param_name => $dfv_compatible_dependency_list,
	}
},

Data can be arranged differently as long as the structure returned is a hash
in the above format


=cut

sub _specification {
	my $self = shift;
	return ();
}

=head2 _runmode_specific_data

Return the names of the runmode-specific fields if there is runmode-specific data;
otherwise returns undef

input:  $self
output: arrayref of runmode-specific fields or undef

=cut


sub _runmode_specific_data {
	my $self = shift;
	if ($self->param('runmode_specific_fields'))
	{	return $self->param('runmode_specific_fields');
	}
	
	# otherwise...
	my @spec = $self->_specification();
	my %spec_h = ( @spec );
	
	my %run_mode_h = $self->run_modes();
	my @run_modes = (keys %run_mode_h, '*');
	my $field_list;
	foreach my $s (keys %spec_h)
	{	# if the key is in the list of run modes, this field is run mode-specific
		foreach my $key (keys %{$spec_h{$s}})
		{	if (grep { $_ eq $key } @run_modes )
			{	push @$field_list, $s;
				last;
			}
		}
	}
	$self->param('runmode_specific_fields', $field_list);
	
	return $field_list || undef;
}

=head2 get_spec

Get the specification for the tool input

input:  $self
        $options
          spec_profile => 'profile_name'  # name of the run mode profile wanted

output: tool input specification

=cut

sub get_spec {
	my $self = shift;
	my $options = shift || {};
	
	my @spec = $self->_specification();
	my %spec_h = ( @spec );
	my @return_spec;
	
	my $rm_specific_fields = $self->_runmode_specific_data;
	if ($rm_specific_fields && @$rm_specific_fields)
	{	# we have run-mode specific data. Extract the appropriate data.
		my $profile = $options->{spec_profile} || $self->get_current_runmode;
		my $new_spec;

		# get the param names in order (preserving the order in case we need it)
		my $n = 0;
		my @keys = grep { $_ if ! ( $n++ % 2 ) } @spec;
		foreach my $s (@keys)
		{	if ( grep { $s eq $_ } @$rm_specific_fields )
			{	if ( $spec_h{$s}{$profile} || $spec_h{$s}{'*'} )
				{	push @return_spec, $s, ( $spec_h{$s}{$profile} || $spec_h{$s}{'*'} );
				}
#				else
#				{	# the field is run-mode-specific but there is no mention of
					# this run-mode in the profile
#				}
			}
			else
			{	push @return_spec, $s, $spec_h{$s};
			}
		}
		@spec = @return_spec;
		%spec_h = ( @return_spec );
	}
	else
	{	$self->debugme("No run mode specific fields. Boo!");
	}

	if ($options->{ordered})
	{	return [ @spec ];
	}
	else
	{	return { %spec_h };
	}

}

=head2 get_spec_param

Get a parameter from the specification

input:	$self
      	{ param => 'xxx' # parameter name
      	  p_type => 'yyy' } # parameter type - e.g. default, form_values, etc..
      	$options (for the specification)
output:	the parameter or undef

=cut

sub get_spec_param {
	my $self = shift;
	my $to_get = shift;
	my $spec = $self->get_spec(@_);
	my $param = $to_get->{param};
	my $p_type = $to_get->{p_type};
	if ($param && $p_type)
	{	return $spec->{$param}{$p_type} || ($self->printerr("The parameter $param $p_type does not exist") && return undef );
	}
	elsif ($param)
	{	return $spec->{$param} || ( $self->printerr("The parameter $param does not exist") && return undef );
	}
	else
	{	$self->printerr("Error in specifying a parameter to return");
		return undef;
	}
}


=head2 _dfv_data

Any exta data for Data::FormValidator
Returns a hashref

=cut

sub _dfv_data {
	return {};
}


=sub dfv_profile

Reads in the spec and returns the profile in a Data::FormValidator-compatible
format.

input:	$self
output:	a DFV format hash

=cut

sub dfv_profile {
	my $self = shift;
#	my $sub_type = shift;

	# get our DFV settings, if there are any
	my $hash = $self->_dfv_data;

	# reorganize the info we have in the spec
	my $spec = $self->get_spec(@_);

	my @dfv_keys = (
'constraint_methods',
'constraints',
'defaults',
'dependencies',
'field_filters',
'optional',
'require_some',
'required',
'untaint_constraint_fields',

#'constraint_method_regexp_map',
#'constraint_regexp_map',
#'defaults_regexp_map',
#'field_filter_regexp_map',
#'optional_regexp',
#'required_regexp',
#'untaint_regexp_map',

# GLOBALS
#'dependency_groups',
#'filters',
#'missing_optional_valid',
#'msgs',
#'untaint_all_constraints',
#'validator_packages',
#'debug',
);

	foreach my $k (keys %$spec)
	{	my $opt = 'optional';
		$hash->{constraint_methods}{$k} = $spec->{$k}{test} if $spec->{$k}{test};
		$hash->{defaults}{$k} = $spec->{$k}{default} if $spec->{$k}{default};
		$opt = 'required' if $spec->{$k}{required};
#		$hash->{dependencies}{$k} = $spec->{$k}{dependencies} if $spec->{$k}{dependencies};
		push @{$hash->{$opt}}, $k;
		foreach (@dfv_keys)
		{	$hash->{$_}{$k} = $spec->{$k}{$_} if $spec->{$k}{$_};
		}
	}
	
	return $hash;
}


=head2 check_input_query

Checks the query against the specification
Sets the $self param 'validated_query' with the checked query

input:	$self
      	$options # hash of options; includes
      	'replace_with_defaults' # puts defaults in for invalid / missing values

output:	$results object

=cut

sub check_input_query {
	my $self = shift;
	$self->startme();
	my $options = shift;

	# make sure that our query_h is up to scratch
#	my $cgi = $self->query();
	my $spec = $self->get_spec();
	my $profile = $self->dfv_profile($options);

	my $results = GO::Data_FormValidator->check( $self->query(), $profile );
#	Data::FormValidator->check( $self->query(), $profile );
	my $valid_h = $results->valid if $results->valid;

	if ( $results->has_missing || $results->has_invalid ) {
		# There was something wrong with the data...
		if ($options->{replace_with_defaults})
		{	$results->replace_invalid_with_default;
		}
	}

	my $valid_data;
	foreach (keys %$valid_h)
	{	next unless $spec->{$_};
		my @values = $results->valid($_);
		# if this param can have multiple values
		if ($spec->{$_}{allow_multiple})
		{	$valid_data->{$_} = [ @values ];
		}
		else
		{	if ($options->{report_multiples} && scalar @values > 1)
			{	$self->warning_msg("Found more than one value for $_. Using the first value.");
			}
			# take the first value if the param can only take one value
			$valid_data->{$_} = $values[0];
		}
	}

	# set the param 'validated_query' with the valid data
	$self->param('validated_query', $valid_data);

	# put the results into the 'validator_results' param
	$self->param('validator_results', $results);

	# return the results object
	return $results;

}


=head2 dfv_do_sub

An interface to allow D::FV to do the subroutines in the specification.

=cut

## DFV interface
sub dfv_do_sub {
	my $self = shift;
	my $sub = shift;
	my @params = @_;
	
	return sub {
		my $dfv = shift;
		
		# Name it to refer to in the 'msgs' system.
		$dfv->name_this($dfv->get_current_constraint_field . "_" . $sub);

		my $dfv_data;
		my @new_params;
		
		if (!@params)  # assume that the current object is the parameter
		{	@new_params = ( $dfv->get_current_constraint_value );
		}
		else
		{	
			foreach my $p (@params)
			{	if (ref($p) eq 'HASH')
				{	if ($p->{this})
					{	push @new_params, $dfv->get_current_constraint_value();
					}
					elsif ($p->{param})
					{	$dfv_data = $dfv->get_filtered_data if !$dfv_data;
						foreach (@{$p->{param}})
						{	push @new_params, $dfv_data->{$_} if defined $dfv_data;
						}
					}
					elsif ($p->{params_as_list})
					{	$dfv_data = $dfv->get_filtered_data if !$dfv_data;
						foreach (@{$p->{params_as_list}})
						{	push @new_params, $dfv_data->{$_} if defined $dfv_data;
						}
					}
					elsif ($p->{params_as_hash})
					{	#	this is for the cases where we want to keep the identity
						#	of the field intact
						$dfv_data = $dfv->get_filtered_data if !$dfv_data;
						my $hash;
						foreach my $key (@{$p->{params_as_hash}})
						{	$hash->{$key} = $dfv_data->{$key} if defined $dfv_data;
						}
						push @new_params, $hash;
					}
					elsif ($p->{all_params})
					{	push @new_params, $dfv->get_filtered_data;
					}
					elsif ($p->{input_data})
					{	push @new_params, $dfv->get_input_data( as_hashref => 1 );
					}
				}
				else
				{	push @new_params, $p;
				}
			}
		}
		return &$sub(@new_params);
	};
}


=head2 create_index

Creates an index of all the items available

input:  array of items, field to index on
output: list of items, sorted and indexed

=cut

sub create_index {
	my $self = shift;
	my $item_arr = shift || return;
	my $index_field = shift || return;

	my $first_letter = "";
	my $index;
	foreach (@$item_arr)
	{	next if lc(substr($_->$index_field, 0, 1)) eq $first_letter;
		$first_letter = lc(substr($_->$index_field, 0, 1));
		$_->add_anchor($first_letter);
		push @$index, $first_letter;
	}

	return $index;

}


=head2 create_url

Creates a string from a query hash. Values are uri_escaped.

input:  hash of query keys and values
output: string ready for output

=cut

sub create_url {
	my $self = shift;
	my $var_h = shift || return;
	my $str;
	
	foreach my $k (keys %$var_h)
	{	# convert into an array, if it isn't one already
		$var_h->{$k} = [ $var_h->{$k} ] if !ref $var_h->{$k};
		push @$str, join( "&", map { $k . '=' . uri_escape($_) } @{$var_h->{$k}} );
	}
	return join( "&", @$str);

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



=head2 get_data_from_file {

Retrieves data from a file

input:  $self, $arg_h containing file => $file_name
output: $arr (may be undefined if nothing came of the parsing)

Any errors encountered by the parser will be put in the app error list

=cut

sub get_data_from_file {
	my $self = shift;
	my $parser = GO::GeneralPurposeParser->new;
	$self->startme();
	# read in the file
	my $arr = $parser->parse_from_file(@_);

	# add any errors
	if ( $parser->has_msgs )
	{	# transfer the errors to the tool
		$self->add_message_list( $parser->get_all_msgs() );
	}
	
	if ($parser->{UNPARSED_DATA})
	{	$parser->debugme("Unparsed data: ".Dumper($parser->{UNPARSED_DATA}));
	}

	return $arr;

}

=head2 write_data_to_file {

Writes data to a file

input:  $self, 
        $arg_h containing 
        - file_name =>   # guess!
        - string =>      # what's to be written in the file
        - write_mode =>  # how to open it (write only or append); defaults to append
                         # if file is present
        - file_separator # if present, prepended to the string
output: nowt



=cut

sub write_data_to_file {
	my $self = shift;
	my $arg_h = shift;
	return unless $arg_h->{file_name} && $arg_h->{string} && ! ref $arg_h->{string} && length $arg_h->{string} > 0;

	## make sure we can open the file.
	my $file = $arg_h->{file_name};
	my $write_mode = '>>'; # set write mode to append
	if (-f $file)
	{	if ($arg_h->{write_mode} && $arg_h->{write_mode} eq 'write')
		{	# ok... we're going to just do a write, not an append!
			$self->warning_msg("Overwriting existing file $file");
			$write_mode = '>';
		}
	}
	
	if (open (FILE, $write_mode . $file))
	{	print FILE $arg_h->{file_separator} if defined $arg_h->{file_separator};
		# append a carriage return to the string if there isn't one already
		$arg_h->{string} .= "\n" if $arg_h->{string} !~ /\n$/;
		# print the string
		print FILE $arg_h->{string};
		close FILE;
	}
	else
	{	$self->fatal_msg("Could not open file $file for writing: $!");
	}
}

1;