package GO::Object::Generic;

## This is a generic object

use strict;
use lib '/Users/gwg/go/scratch/tools';
#use Carp;
#use Exporter;
use Data::Dumper;
use GO::TestSet qw(dfv_test);
use base 'GO::MsgLite';
use Data::FormValidator;
use Data::FormValidator::Constraints qw(:closures);

use vars qw($AUTOLOAD);

### DFV STUFF ###

# all possible DFV keys
sub __all_dfv_keys {
	my $self = shift;
	return (
		$self->__single_param_hash_dfv_keys,
		$self->__single_param_arr_dfv_keys,
		$self->__multi_param_dfv_keys,
		$self->__global_dfv_keys,
	);
}

# global switches
sub __global_dfv_keys {
	return (
	'filters',            # arr
	'untaint_all_constraints',      # bool
	'missing_optional_valid',       # bool
	'validator_packages', # arr
	'msgs',               # hash
	'debug',              # bool
#	'required_regexp',    # scalar
#	'optional_regexp',    # scalar
	);
}

# these apply to several params
sub __multi_param_dfv_keys {
	return (
	'require_some',       # hash (made up key)
	'dependency_groups',  # hash (   ditto   )
#	'defaults_regexp_map',          # hash
#	'field_filter_regexp_map',      # hash
#	'constraint_method_regexp_map', # hash
#	'untaint_regexp_map',           # hash
	);
}

# these can be specified on a per-param basis
sub __single_param_hash_dfv_keys {
	return (
	'dependencies',       # hash
	'defaults',           # hash
	'field_filters',      # hash
	'constraint_methods', # hash
	);
}

sub __single_param_arr_dfv_keys {
	return (
	'required',           # arr
	'optional',           # arr
	'untaint_constraint_fields',    # arr
	);
}


sub __valid_form_data_keys {
	return (
		'human_name',
		'list_items',
		'human_name',
		'subtext',
		'list_values',
		'list_values_human_name_h',
		'allow_multiple',
		'test',
		'form_input_type',
#		'required',
#		'optional',
	);
}

=head2 _object_data

All data pertaining to an object. Split into two sections, dfv_profile and specification

{ __DFV_PROFILE => { }, __PARAM_SPEC => [ ] }

=cut

sub _object_data {
	my $self = shift;
	
	if ($self->{__DFV_PROFILE} || $self->{__OBJECT_SPEC})
	{	return { 
			dfv_profile => $self->{__DFV_PROFILE},
			specification => $self->{__OBJECT_SPEC}
		};
	}
	elsif ($self->{dfv_data} || $self->{form_data})
	{	$self->_organize_obj_data;
		return {
			dfv_profile => $self->{__DFV_PROFILE},
			specification => $self->{__OBJECT_SPEC}
		};
	}
	
	return {};
}

=head2 _organize_obj_data

Sort out existing object data into a DFV profile and a spec

=cut

sub _organize_obj_data {
	my $self = shift;
	my $obj_data = $self->_object_data || return;
	
	return {} if ! $obj_data->{dfv_data} && ! $obj_data->{form_data};

	my $profile;
	## process the dfv_data
	if ($obj_data->{dfv_data} && %{$obj_data->{dfv_data}})
	{	foreach (@{$self->__all_dfv_keys})
		{	if ($obj_data->{dfv_data}{$_})
			{	$profile->{$_} = $obj_data->{dfv_data}{$_};
			}
		}
	}

	my $reqd_h;
	## deparse dfv require_some param
	if ($profile->{require_some})
	{	foreach my $r (values %{$profile->{require_some}})
		{	if ( ! ref( $r ) || ref( $r ) ne 'ARRAY' )
			{	if ($r->[0] =~ /^\d+$/)
				{	shift @$r;
				}
				foreach (@$r)
				{	$reqd_h->{$_} = 'some';
				}
			}
			else
			{	warn "$_ should be of type ARRAY\n";
			}
		}
	}
	
	foreach my $r ('required', 'optional')
	{	if ($profile->{$r})
		{	$reqd_h->{$_} = $r foreach @{$profile->{$r}};
		}
	}
	
	my $spec;
	## now let's see what form data we have
	if ($obj_data->{form_data})
	{	if (ref $obj_data->{form_data} ne 'ARRAY')
		{	# if we have a different data struct, convert it into a list
			if ($obj_data->{form_data}{order} && @{$obj_data->{form_data}{order}} && $obj_data->{form_data}{data_h} && %{$obj_data->{form_data}{data_h}})
			{	foreach my $p (@{$obj_data->{form_data}{order}})
				{	if ($obj_data->{form_data}{data_h}{$p})
					{	$p = { %{$obj_data->{form_data}{data_h}{$p}}, id => $p };
					}
					else
					{	$p = { id => $p };
					}
				}
				$obj_data->{form_data} = $obj_data->{form_data}{order};
			}
		}

		if (@{$obj_data->{form_data}})
		{	foreach my $data (@{$obj_data->{form_data}})
			{	warn "No ID found for spec param!\n" && next unless $_->{id};
				my $p = $data->{id};
				$spec->{by_param}{$p} = $data;

				# copy the defaults, dependencies, field_filters and constraint_methods
				# the form_data takes precedence at the moment
				foreach ( $self->__single_param_hash_dfv_keys )
				{	if ($data->{$_}) # && ! $profile->{$_}{$p})
					{	$profile->{$_}{$p} = $data->{$_};
					}
					elsif ($profile->{$_}{$p}) # && ! $data->{$_})
					{	$spec->{by_param}{$p}{$_} = $profile->{$_}{$p};
					}
				}
				
				# copy the tests
				if ($data->{test}) # && ! $profile->{constraint_methods}{$p})
				{	$profile->{constraint_methods}{$p} = $data->{test};
				}

				# whether or not the field is optional / required / etc.
				if ($reqd_h->{$p}) # specified in the DFV profile
				{	# mark to show that the field is required
					if ($reqd_h->{$p} eq 'required')
					{	$spec->{by_param}{$p}{required} = 1;
					}
				}
				else
				{	my $opt;
					foreach my $r ('required', 'optional')
					{	if ($data->{$r}) # put this data in the DFV profile
						{	push @{$profile->{$r}}, $p;
							$opt = $r;
							last;
						}
					}
					if (!$opt && ! $reqd_h->{$p} ) # opt isn't yet specified
					{	# set it to optional
						push @{$profile->{optional}}, $p;
					}
				}
				push @{$spec->{ordered}}, $spec->{by_param}{$p};
			}
		}
		else
		{	warn "Help! I can't decode this profile!";
		}
	}

	$obj_data->{__DFV_PROFILE} = $self->{__DFV_PROFILE} = $profile;
	$obj_data->{__OBJECT_SPEC} = $self->{__OBJECT_SPEC} = $spec;

}


=head2 _specification

Data structure containing the object specification

=cut

sub _specification {
	my $self = shift;
	# get all our object data
	my $obj_data = $self->_object_data;
	# see if the spec has already been generated. Return it if so.
	if ($obj_data && $obj_data->{specification})
	{	return $obj_data->{specification};
	}
	# return empty list otherwise
	return [];
}


=head2 _dfv_data

Return a hash containing any extra dfv data which won't fit into the spec


sub _dfv_data {
	# could be any of the fields in __global_dfv_keys or __multi_param_dfv_keys
	return {};
}
=cut


=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 $param_names = shift;

	# get all our object data
	my $obj_data = $self->_object_data;
	return $obj_data->{dfv_profile} || {};

#	# see if the DFV profile has already been generated. Return it if so.
#	if ($obj_data && $obj_data->{dfv_profile})
#	{	return $obj_data->{dfv_profile};
#	}
	

}

=head2 get_spec

Get the specification for the object
Additional argument gets the spec as an ordered array

input:  $self, additional parameter if it should be returned ordered
output: if ordered is set, returns the spec as an arrayref
        otherwise, returns spec as a hashref

=cut

sub get_spec {
	my $self = shift;
	my $ordered = shift;
	my $spec = $self->_specification;
	if ($ordered)
	{	return $spec->{ordered};
	}
	else
	{	my %object_spec_h = ($spec->{by_param});
		return \%object_spec_h;
	}
}

=head2 get_spec_for_param

Get the specification for a certain parameter of the object

=cut

sub get_spec_for_param {
	my $self = shift;
	my $param = shift || return;
	my $object_spec = shift || $self->get_spec();
	return $object_spec->{$param} || undef;
}

=head2 get_name_for_param

Get the proper name for a certain parameter of the object

UNUSED

sub get_name_for_param {
	my $self = shift;
	my $param = shift || return;
	my $object_spec = shift || $self->get_spec();
	return $object_spec->{$param}{name} if $object_spec->{$param}{name};
	
	$param =~ s/_/ /g;
	
	return ucfirst $param;
}

=cut

=head2 get_valid_params

Get the valid parameters for the object
(in the order in which they appear in the spec)

=cut

sub get_valid_params {
	my $self = shift;
	my $object_spec_list = $self->get_spec('ordered');

	return [ map { $_->{id} } @$object_spec_list ];
}


##
sub is_valid_param_p {
	my $self = shift;
	my $param = shift;
	my $object_spec = $self->get_spec();
	return 1 if $object_spec->{$param};
	return;
}


### Errors ###

=head2 create_error_message

Create an error message from a D::FV::R object

input:  $self, $arg_h->{results}, # D::FV::R results
output: an error message

=cut

sub create_error_message {
	my $self = shift;
	my $arg_h = shift;
	$self->startme();
	$self->debugme("arg_h: ".Dumper($arg_h));

	return if ! defined $arg_h->{results};
	
	return join "<br>", @{GO::Utilities::summarize_errors($arg_h->{results})};
}


### Creating objects and adding parameters ###

=head2 new

Create a new object using the params in @_ as the values

input:  object type, arg_h containing data for the object
        arg_h should look this:
        - data
        - object_spec    # optional
        - dfv_profile    # optional
        - transform_data # optional; if present, the data should be transformed
        - check_input    # optional; input will be checked if present
output: self (hopefully with plenty of data!)
output: the object created

=cut

sub new {
	my $proto = shift;

	# create and bless the object
	my $obj = &_create_and_bless($proto);

	# initialise the object using the params in @_
	return $obj->_initialise(@_);

}


=head2 _create_and_bless

Basic sub to create a new object in a certain class

input:  object type
output: blessed object of that type

=cut

sub _create_and_bless {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	bless $self, $class;
	return $self;
}

=head2 _initialise

Given an object, data and the object spec, goes through and adds data
from a hash to the object

input:  self, arg_h containing
        - data
        - object_spec    # optional
        - dfv_profile    # optional
        - transform_data # optional; if present, the data should be transformed
        - check_input    # optional; input will be checked if present
        - return_as = 'success_hash'  # optional
output: self (hopefully with plenty of data!)

=cut

sub _initialise {
	my $self = shift;
#	$self->startme();
	my $arg_h = shift;
	my $return_success_hash;
	$return_success_hash = 1 if $arg_h->{return_as} && $arg_h->{return_as} eq 'success_hash';

	# get the data
	# if it isn't in the preferred input format of $arg_h->{data},
	# assume $arg_h contains the data

	my $data_h = $arg_h->{data} || $arg_h || {};

	if ($arg_h->{transform_data})
	{	# we need to transform the data before doing anything else
		$data_h = $self->transform_parsed_data($arg_h);
	}

	my $results;

	# see if we are going to be checking the input or not
	if ($arg_h->{check_input})
	{	## get the DFV profile
		my $profile = $arg_h->{dfv_profile} || $self->dfv_profile;
	
		## validate the input hash data
		my $results = Data::FormValidator->check( $data_h, $profile );
		
		if (!$results->success)
		{	# create an error message and add it to the return_h
			my $err_msg = $self->create_error_message({ input => $data_h, results => $results });

			$self->printerr("new [ ". $self ." ] failed the test:\n$err_msg");
			$self->debugme("broken object: ".Dumper($data_h)."\n");

			if ($return_success_hash)
			{	return { ERROR_LIST => [ { CLASS => 'fatal', MSG => "$self object creation failed: ".$err_msg, CALLER => (caller(0))[3], OBJECT => $data_h, RESULTS_OBJECT => $results }, ], };
			}
			else
			{	return $self;
			}
		}
		
		## put the valid results into the $arg_h->{data}
		$arg_h->{data} = $results->valid;
	}

	my $object_spec = $arg_h->{object_spec} || $self->get_spec();

	# go through the data; 
	# there may be some pieces of data that need to be dealt with
	# in a particular way. Other than that, we can just add the params
	foreach my $param (keys %$object_spec)
	{	my $value = $self->create_param_data( $param, $data_h );
		# if there's no data, go on to the next one
		next if ! defined $value;

		$self->set_param({ param => $param, value => $value, param_spec => $object_spec->{$param}, add => 1 });
	}
	
	if ($return_success_hash)
	{	$results = { SUCCESS => 1, OBJECT => $self };
	}
	else
	{	$results = $self;
	}
	
	return $results;
}


=head2 transform_parsed_data

input:  $self, $arg_h containing
        - data # the data hash
        - object_spec # object specification (optional)
output: the data hash with any appropriate transformations done on it

This is for transforming parsed data BEFORE any error checking occurs

=cut

sub transform_parsed_data {
	my $self = shift;
	my $arg_h = shift;
	my $data_h = $arg_h->{data};
	
	## do any transformations here
	return $data_h;
}

=head2 add_param

Add a value to a parameter

input:  self, arg_h hash containing
        - value # the value
        - param # param to which the value should be added
        - object_spec  # the full object spec (optional)
        - param_spec # the spec for that parameter (optional)
output: self->param or undefined if the param does not exist

=cut

sub add_param {
	my $self = shift;
	my $arg_h = shift;

	return $self->set_param({ %$arg_h, add => 1 });

}

=head2 set_param

Set a parameter (overriding an existing parameter if appropriate)

input:  self, arg_h hash containing
        - value # the value
        - param # param to which the value should be added
        - object_spec  # the full object spec (optional)
        - param_spec # the spec for that parameter (optional)
        - add # if present, will add the param to an existing list, rather than
              # replacing the list
output: self->param or undefined if the param does not exist

=cut

sub set_param {
	my $self = shift;
	my $arg_h = shift;

	return undef unless $arg_h->{param} && $arg_h->{value};
	
	my $do_this = "set";
	if ($arg_h->{add})
	{	$do_this = "add";
	}

	my $method = $do_this."_".$arg_h->{param};
	if (exists &$method)
	{	return $self->$method($arg_h);
	}

	my $param_spec = $arg_h->{param_spec} ||
		$arg_h->{object_spec}{$arg_h->{param}} ||
		$self->get_spec_for_param($arg_h->{param});
	
	if (!$param_spec)
	{	## no spec present... we can't add this param to the object
		$self->debugme("error! Cannot $do_this param ".$arg_h->{param}." to the object.");
		return undef;
	}
	
	#	check the param if required
	if ($arg_h->{check_param})
	{	return undef unless $self->check_param($arg_h);
	}

	$arg_h->{value} = [ $arg_h->{value} ] if ref( $arg_h->{value} ) ne 'ARRAY';

	# params that are lists
	if ($param_spec->{allow_multiple} && $param_spec->{allow_multiple} == 1)
	{	if ($do_this eq 'add')
		{	push @{$self->{ $arg_h->{param} }}, @{$arg_h->{value}};
		}
		else
		{	$self->{ $arg_h->{param} } = $arg_h->{value};
		}
	}
	else
	{	$self->{ $arg_h->{param} } = $arg_h->{value}[0];
	}

	return $self->{ $arg_h->{param} };

}



=head2 create_param_data

Sub to allow any jiggery-pokery that might need to be done to data for a param.
Occurs AFTER error checking. Do we need this?

input:  self, parameter, data
output: the data for the parameter

=cut

sub create_param_data {
	my $self = shift;
	my ($param, $data) = @_;
	
	# any special stuff that needs to be done, e.g. making objects, etc., goes here

	return $data->{$param} || undef;
}


=head2 check_param

Check that the data for a parameter is OK

input:  self, arg_h containing
        - param
        - value
output: 1 if the value(s) is/are valid
        undef if there's something wrong

=cut

sub check_param {
	my $self = shift;
	my $arg_h = shift;
	if (! defined $arg_h->{param} || ! exists $arg_h->{value})
	{	$self->debugme("Missing param or value for check_and_add_param\nParam: ".($arg_h->{param} || undef)."; value: ".($arg_h->{value} || undef));
		return undef;
	}
	
	if (!$self->is_valid_param_p($arg_h->{param}))
	{	$self->debugme($arg_h->{param} . " is not a valid param!");
		return undef;
	}

	# check if it passes the test
	# get the DFV profile for the param
	my $dfv_prof = $self->dfv_profile([ $arg_h->{param} ]);
	
	## validate the input hash data
	my $results = Data::FormValidator->check( { $arg_h->{param} => $arg_h->{value} }, $dfv_prof );
	
	return 1 if $results->success;
	
	if (!$results->success) {
		# there was a problem in the input hash
		# summarize the errors
		my $err_arr = GO::Utilities::summarize_errors($results);
		$self->debugme("new param " . $arg_h->{param} . " failed the test:\n" . join("\n", @$err_arr)."\n");
		$self->warning_msg( join '<br>', @$err_arr );
	}
	return undef;
}


=cut
sub add_Object {
	my $self = shift;
	my $arg_h = shift || return;

	my $obj_type = $arg_h->{obj_type} || return;
	my $data = $arg_h->{data} || return;
	
	#	check that we have 
	$self->debugme("object type: $obj_type");
	eval "require $obj_type";

	if ($@) {
		$self->debugme("error: ".Dumper($@));
#		$self->printerr("$obj_type is not installed!");
		$self->add_error( { CLASS => 'fatal', MSG => "$obj_type is not installed on this system.", CALLER => (caller(0))[3] } );
		return;
	}

	my $results = $obj_type->new_object_from_parsed_data($arg_h);
	if ($results->{OBJECT})
	{	my $add_as = $arg_h->{add_as};
		if (!$add_as)
		{	($add_as = $obj_type) =~ s/.*::(.+)/\L$1/;
		}
		$self->{$add_as} = $results->{OBJECT};
	}
	
	if ($results->{ERROR_LIST})
	{	$self->
	
}
=cut

=head2 obj_to_text

Converts an object into the textual representation thereof

=cut

sub obj_to_text {
	my $self = shift;
	$self->startme();
	my $arg_h = shift; # 
	my $valid_params = $self->get_valid_params;
	
	$self->debugme("valid params: ".join(", ", @$valid_params));
	
	my $str; # the string representing the data

	#	use either the data separator set in 'arg_h' or \n
	my $data_sep = $arg_h->{data_sep} || "\n";
	#	tag-value separator
	my $tag_val_sep = $arg_h->{tag_val_sep} || ":";
	foreach my $p (@$valid_params)
	{	$self->debugme("param $p");
		if ($self->$p)
		{	$self->debugme("found value for self->$p: it is ".Dumper($self->$p));
			my $param_spec = $self->get_spec_for_param($p);
			if ($param_spec->{allow_multiple} && $param_spec->{allow_multiple} == 1)
			{	
		#		$str .= $p . $tag_val_sep . " " . Dumper($self->$p) . $data_sep;
				foreach ( @{$self->$p} )
				{	$str .= $p . $tag_val_sep . " " . $_ . $data_sep;
				}
			}
			else
			{	$str .= $p . $tag_val_sep . " " . $self->$p . $data_sep;
			}
		}
		else
		{	$self->debugme("Can't do self->" . $p . "... crap!");
		}
	}
	return $str;
}



# auto-declare accessors
sub AUTOLOAD {
	my $self = shift;
	my $name = $AUTOLOAD;
	return if $name =~ /DESTROY/;

	$name =~ s/^.*:://;   # strip fully-qualified portion

	my $do_this;
	my $arg_h;
	if ($name =~ /^(add|set)_.+/)
	{	$do_this = $1;
		$name =~ s/^(add|set)_//;
	}
	
	# check if the name is a valid param or not
	if ($self->is_valid_param_p($name))
	{	# phew!
	}
	elsif ($self->is_valid_param_p($name."_list"))
	{	# add "_list" to it
		$name.= "_list";
	}
	else
	{	# holy crap! What's going on here?!
		# this isn't a valid param
		$self->printerr("Can't do $name on self");
		return;
	}

	if ($do_this)
	{	# create the args for adding a parameter
		# obviously we need an argument...
		return unless @_;
		# this is our argument so far
		my $input = shift;
		if (ref($input) eq 'HASH')
		{	# proper format. Phew!
			%$arg_h = %$input;
		}
		else
		{	# input is something else
			# assume it is the value
			$arg_h->{value} = $input;
		}
		#	send the argument to add_param
		$self->debugme("sending $name to add_param");
		$arg_h->{param} = $name;
		$arg_h->{add} = 1 if $do_this eq 'add';
		return $self->set_param($arg_h);
	}
	else
	{	return $self->{$name};
	}

#	confess("$self") unless ref($self);
	 

#	my $add;
#	if ($name =~ /add_(.+)/) {
#		$add = $1."_list";
#	}
	
#	if ($self->can($name)) {
#		confess("assertion error!");
#	}

#	if ($add && $self->is_valid_param_p($add)) {
#		push(@{$self->{$add}}, @_);
#		return $self->{$add};
#	}
#	else {
#		confess("can't do $name on $self");
#	}
}


1;