package MpmasInputfile;

use strict;
use warnings;
use Exporter;
use Storable qw(dclone);
use Data::Dumper;
use SimpleObjectRegistry;
use MpmasInputBlock;
use SimpleObject;
use Carp;
our @ISA = qw(SimpleObject);

#constants
use constant {
  DEFBASEMILP => 10
  
};

sub shortError {
	my ($in) = @_;
	my $pos = index $in, "\n at";
	$in = substr $in, 0, $pos;

	$in =~ s/^(.+)at .+pm line \d+.*$/$1/;

	return $in;
}

#Global references for all input files - initialized by class function set_global_references
my $mname;
my $outdir;
my $outdir_cm;
my $inihash;
my $configs;
my $setup;
my $ActivityRegistry;
my $ConstraintRegistry;
my $NetworkObjectRegistry;
my $PerennialObjectRegistry;
my $LivestockObjectRegistry;
my $TPPenaltyObjectRegistry;

my $MultiperiodInserterRegistry;
my $MultiperiodReaderRegistry;
my $defaults_for_simrunParameters;

my $SOSRegistry;
my $SortedActivityRef;
my $SortedQuadActRef;
my $SortedConstraintRef;
my $SortedObjectRef;
my $MILPinfo;
my $other_class_globals;
my $dbh;
my $backwards;
my $specobjname;
my $specobjindex;
my $specobjtype;
my $tableau_compact;
my %group_scripts;
my $milplist = [("MQ")];
my $agentinfo;
my $Exchanges;
my $Number_of_exchanges;
my $fileregistry;
my $nocommented = 0;
my $strictlySorted = 1;
my $extraMarketYears = 1;
my $mu = undef;
my $starttime;


my %ExtraAgentCharCodes;
my %ExtraCropActCharCodes;

my %typeMapActivities = ();
my %typeMapConstraints = () ;


#Methods for all files, do not overload with specific class methods
sub set_global_references {
	shift; #ignore invoker
	$mname = shift;
	$outdir = shift;
	$outdir_cm = shift;
	$inihash = shift;
	$configs = shift;
	$setup = shift;
	$ActivityRegistry = shift;
	$ConstraintRegistry = shift;
	$NetworkObjectRegistry = shift;
	$PerennialObjectRegistry = shift;
	$LivestockObjectRegistry = shift;
	$TPPenaltyObjectRegistry = shift;
	$SOSRegistry = shift;
	$dbh = shift;
	$backwards = shift;
	$tableau_compact = shift;
	$mu = shift;
	$starttime = shift;
	$MultiperiodInserterRegistry = shift;
	$MultiperiodReaderRegistry = shift;
	$defaults_for_simrunParameters = shift;
}
sub set_global {
	$other_class_globals->{$_[1]} = $_[2];
}
sub get_global {
	return $other_class_globals->{$_[1]};
}
sub set_global_table {
	$other_class_globals->{$_[1]} = $_[2];
	MpmasQLFunctionLanguage->register_table($_[2]);
}
sub get_simrun_parameter_default {
	return $defaults_for_simrunParameters->{$_[1]}->{default_value};
}
sub get_simrun_parameter_id {
	return $defaults_for_simrunParameters->{$_[1]}->{id};
}
sub get_simrun_parameter_list {
	return [ sort {$a cmp $b} keys %$defaults_for_simrunParameters ];
}

sub get_num_simrun_parameters {
	return  scalar(keys %$defaults_for_simrunParameters) ;
}

sub get_dbh {
	return $dbh;
}
sub set_milpinfo {
	$MILPinfo = $_[1];
}
sub set_milpinfo_entry {
	$MILPinfo->{$_[1]} = $_[2];
}
sub get_milpinfo_solution_pool {
	return $MILPinfo->{TargetValuePool}[$_[1]];
}
sub set_milpinfo_solution_pool {
	$MILPinfo->{TargetValuePool}[$_[1]] = $_[2];
}
sub delete_milpinfo_solution_pool {
	$MILPinfo->{TargetValuePool} = undef;
}
sub print_milpinfo_solution_pool {
	if (exists  $MILPinfo->{TargetValuePool}  and defined $MILPinfo->{TargetValuePool} ) {
		for my $i (0 .. $#{ $MILPinfo->{TargetValuePool} } ) {
			print  "$i:\t", $MILPinfo->{TargetValuePool}[$i],"\n";
		}
	}
}

sub set_specobj_info {
	$specobjname = $_[1];
	$specobjindex = $_[2];
	$specobjtype = $_[3];
}
sub get_specobj_names {
	return $specobjname;
}
sub get_specobj_indices {
	return $specobjindex;
}
sub get_specobj_types {
	return $specobjtype;
}
sub set_sorted_constraints {
	$SortedConstraintRef = $_[1];
	unless (MpmasMILPConstraint->lazy_constraint()){
	    $ConstraintRegistry->resort_by_array_ref($_[1]);
	}
}
sub set_sorted_activities {
	$SortedActivityRef = $_[1];
	unless (MpmasMILPActivity->lazy_activity()){
	    $ActivityRegistry->resort_by_array_ref($_[1]);
	}
}
sub set_sorted_quadratic_activities {
	$SortedQuadActRef = $_[1];
}
sub set_sorted_networkobjects {
	shift;
	$SortedObjectRef = shift;
}
sub set_constraint_registry {
	$ConstraintRegistry = $_[1];
}
sub set_activity_registry {
	$ActivityRegistry = $_[1];
}
sub set_networkobject_registry {
	$NetworkObjectRegistry = $_[1];
}
sub set_SOS_registry {
	$SOSRegistry = $_[1];
}
sub set_fileregistry {
	$fileregistry = $_[1];
}
sub get_constraint_registry {
	return $ConstraintRegistry;
}
sub get_activity_registry {
	return $ActivityRegistry;
}
sub get_networkobject_registry {
	return $NetworkObjectRegistry;
}
sub get_inserter_registry {
    return \$MultiperiodInserterRegistry;
}
sub set_inserter_registry {
	$MultiperiodInserterRegistry = $_[1];
    
}

sub get_reader_registry {
	return $MultiperiodReaderRegistry;
}

sub get_penalty_registry {
	return $TPPenaltyObjectRegistry;
}
sub get_SOS_registry {
	return $SOSRegistry;
}
sub get_fileregistry {
	return $fileregistry;
}
sub file {
	return $fileregistry->get_object_by_id($_[1]);	
}
sub file_of_set {
	my $set = $fileregistry->get_object_by_id($_[1]);	
	print STDERR "Error: Fileset $_[1] not created (yet)!" and exit(1) unless (defined $set);
	return $set->file($_[2]);
}	
sub set_configs {
	$configs = $_[1]; #for runonly
}
sub config_entry {
	return $configs->{$_[1]};
}
sub config_entry_or_croak {
	croak "Error: $_[1] not defined\n" unless (defined $configs->{$_[1]});
	return $configs->{$_[1]};
}
sub config_entry_or_die {
	print STDERR "Error: $_[1] not defined\n" and exit(1) unless (defined $configs->{$_[1]});
	return $configs->{$_[1]};
}
sub set_config_entry {
	$configs->{$_[1]} = $_[2];
}

sub setup_entry {
	return $setup->{$_[1]};
}
sub setup {
	return $setup;
}

sub ini_entry {
	return $inihash->{$_[1]};
}
sub backwards_compatibility {
	return (defined $backwards and $_[1] >= $backwards );
}
sub tableau_compact {
    return $tableau_compact;
}
sub set_milplist {
  $milplist = $_[1];
}
sub milplist {
  return $milplist;
}
sub set_extraMarketYears {
  $extraMarketYears = $_[1];
}
sub extraMarketYears {
  return $extraMarketYears;
}

sub agentinfo {
    return $agentinfo;
}
sub set_agentinfo {
    $agentinfo  = $_[1];
}
sub activity {
	return $ActivityRegistry->get_object_by_id($_[1]);
}
sub lp_column_of_activity {
    if (MpmasMILPActivity->lazy_activity()){
        $ActivityRegistry->get_position_by_id($_[1])
    }
    else {
	    my $i = $ActivityRegistry->get_object_by_id($_[1]);
	    croak "Activity $_[1] not defined!" unless (defined $i);
	    return $i->lp_column;
    }	
}
sub add_activities {
	shift;
	$ActivityRegistry->add_objects(@_);
}
sub add_activities_from_ref {

	$ActivityRegistry->add_objects_from_ref($_[1]);
}
sub number_of_activities {
	return $ActivityRegistry->counter;
}
sub activities {
	return $ActivityRegistry->object_list;
}
sub activities_by_ref {
	return $ActivityRegistry->object_list_ref();
}
sub sorted_activities {
    if (MpmasMILPActivity->lazy_activity()){

        return $ActivityRegistry->get_object_by_position($_[1])->id() if (defined $_[1]);
        print STDERR "Warning: sorted_activities called despite --lowmem!\n";
        unless (defined $SortedActivityRef) {
            $SortedActivityRef = [ map { $_->id()} @{ $_[0]->sorted_activity_objects()} ]
        }
    }

	return $SortedActivityRef->[$_[1]] if (defined $_[1]);
	return @{$SortedActivityRef};
}
sub sorted_quadratic_activities {
	return $SortedQuadActRef->[$_[1]] if (defined $_[1]);
	return @{$SortedQuadActRef};
}
sub sort_activity_objects {
    my $self = shift; #remove class name from @_
    $ActivityRegistry->sort_objects(@_);
	my $g = -1;
	for my $x (@{$ActivityRegistry->object_list_ref}){
		$x->set_lp_column( ++$g);
		print  "Activity ",$x->id(), " placed into col ", $x->lp_column(),"\n" if $::loudorder;
	
	}
}
sub sorted_activity_objects {
    print STDERR "Error in sorted_activity_objects. Activities have not been sorted yet!\n" unless ($ActivityRegistry->is_sorted());
	return $ActivityRegistry->get_object_by_position($_[1]) if (defined $_[1]);
	return $ActivityRegistry->object_list_ref;
}



sub sorted_constraint_attr {
	my ($self,$attr,$thismilp) = @_;
	my @temp;
	for my $h (@{$self->sorted_constraint_objects}) {
		push @temp, $h->attr($attr, $thismilp);
	}
	return @temp;
}
sub sorted_activity_attr {
	my ($self,$attr,$thismilp) = @_;
	my @temp;
	for my $h (@{$self->sorted_activity_objects}) {
		push @temp, $h->attr($attr, $thismilp);
	}
	return @temp;
}
sub sorted_activity_vtype {
	my ($self,$thismilp) = @_;
	my @temp;
	for my $h (@{$self->sorted_activity_objects}) {
		push @temp, ($h->attr_defined("quadratic", $thismilp) ? $h->attr("quadratic", $thismilp) : $h->get_default_value("quadratic")) * 2 + ($h->attr_defined("integ", $thismilp) ? $h->attr("integ", $thismilp) : $h->get_default_value("integ") );
	}
	return @temp;
}
sub constraint {
	return $ConstraintRegistry->get_object_by_id($_[1]);
}
sub lp_row_of_constraint {
	my $i = $ConstraintRegistry->get_object_by_id($_[1]);
	croak "Constraint $_[1] not defined!" unless (defined $i);
    if (defined $i->lp_row) {
    	return $i->lp_row 
    } 
    else {	
        print STDERR "Error in lp_row_of_constraint_object. Constraints have not been sorted yet!\n" unless ($ConstraintRegistry->is_sorted());
        return $ConstraintRegistry->get_position_of_object($_[1]);
    }
}
sub lp_row_of_constraint_object {
    if (defined $_[1]->lp_row) {
    	return $_[1]->lp_row 
    } 
    else {	
        print STDERR "Error in lp_row_of_constraint_object. Constraints have not been sorted yet!\n" unless ($ConstraintRegistry->is_sorted());
        return $ConstraintRegistry->get_position_of_object($_[1]);
    }
}
sub add_constraints {
	shift;
	$ConstraintRegistry->add_objects(@_);
}
sub add_constraints_from_ref {
	$ConstraintRegistry->add_objects_from_ref($_[1]);
}

sub number_of_constraints {
	return $ConstraintRegistry->counter;
}
sub constraints {
	return $ConstraintRegistry->object_list;
}
sub constraints_by_ref {
	return $ConstraintRegistry->object_list_ref();
}
sub sorted_constraints {
    if (MpmasMILPConstraint->lazy_constraint()){

        return $ConstraintRegistry->get_object_by_position($_[1])->id() if (defined $_[1]);
        print STDERR "Warning: sorted_constraints called despite --lowmem!\n"; 
        unless (defined $SortedConstraintRef) {
            $SortedConstraintRef = [ map { $_->id()} @{ $_[0]->sorted_constraint_objects()} ]
        }
    }

	return $SortedConstraintRef->[$_[1]] if (defined $_[1]);
	return @{$SortedConstraintRef};
}
sub sort_constraint_objects {
    my $self = shift; #remove class name from @_
    $ConstraintRegistry->sort_objects(@_);
	my $g = -1;
	for my $x (@{$ConstraintRegistry->object_list_ref}){
		$x->set_lp_row( ++$g);
		print  "Constraint ",$x->id(), " placed into row ", $x->lp_row(),"\n" if $::loudorder;
	
	}
}
sub sorted_constraint_objects {
    print STDERR "Error in sorted_constraint_objects. Constraints have not been sorted yet!\n" unless ($ConstraintRegistry->is_sorted());
	return $ConstraintRegistry->get_object_by_position($_[1]) if (defined $_[1]);
	return $ConstraintRegistry->object_list_ref;
}



sub constraint_object_at_row {
    print STDERR "Error in constraint_object_at_row. Constraints have not been sorted yet!\n" unless ($ConstraintRegistry->is_sorted());
    return $ConstraintRegistry->get_object_by_position($_[1]);
}
sub constraint_at_row {
	my $h = $_[0]->sorted_constraints($_[1]);
	return $_[0]->constraint($h);
}
sub constraint_id_at_row {
	return $_[0]->sorted_constraints($_[1]);
}
sub activity_object_at_col {
    print STDERR "Error in activity_object_at_col. Activities have not been sorted yet!\n" unless ($ActivityRegistry->is_sorted());
    return $ActivityRegistry->get_object_by_position($_[1]);
}

sub activity_at_col {
	my $h = $_[0]->sorted_activities($_[1]);
	return $_[0]->activity($h);
}
sub activity_id_at_col {
	return $_[0]->sorted_activities($_[1]);
}

sub networkobject {
	return $NetworkObjectRegistry->get_object_by_id($_[1]);
}
sub networkobjects {
	return $NetworkObjectRegistry->object_list;
}
sub number_of_networkobjects {
	return $NetworkObjectRegistry->counter;
}
sub sorted_networkobjects {
	return $SortedObjectRef->[$_[1]] if (defined $_[1]);
	return @{$SortedObjectRef};
}
sub perennialobject {
	return $PerennialObjectRegistry->get_object_by_id($_[1]);
}
sub perennialobjects {
	return $PerennialObjectRegistry->object_list;
}
sub number_of_perennialobjects {
	return $PerennialObjectRegistry->counter;
}
sub livestockobject {
	return $LivestockObjectRegistry->get_object_by_id($_[1]);
}
sub livestockobjects {
	return $LivestockObjectRegistry->object_list;
}
sub number_of_livestockobjects {
	return $LivestockObjectRegistry->counter;
}
sub SOS {
	return $SOSRegistry->get_object_by_id($_[1]);
}
sub SOSs {
	return $SOSRegistry->object_list;
}
sub number_of_SOS {
	return $SOSRegistry->counter;
}

sub set_agent_attribute_ids {
	my ($self, $ref) = @_;		
	%ExtraAgentCharCodes = %$ref;
	
}
sub get_id_of_agent_attribute {
	my ($self, $attribute) = @_;		
	my $atcode = $ExtraAgentCharCodes{$attribute};
	return $atcode;
}
sub get_num_of_agent_attributes {
	my ($self) = @_;		
	return scalar(keys %ExtraAgentCharCodes);
}

sub set_cropact_attribute_ids {
	my ($self, $ref) = @_;		
	%ExtraCropActCharCodes = %$ref;
	
}
sub get_id_of_cropact_attribute {
	my ($self, $attribute) = @_;		
	my $atcode = $ExtraCropActCharCodes{$attribute};
	return $atcode;
}





sub milpinfo {
	return $MILPinfo->{$_[1]};
}

sub mname {
	return $mname;
}
sub get_activity_type_order {
	return $_[0]->config_entry("ACTTYPEORDER");
}
sub get_constraint_type_order {
	return $_[0]->config_entry("CONTYPEORDER");
}

sub outdir {
	return $outdir;
}

sub outdir_cm {
	return $outdir_cm;
}

sub find_special_constraint {
	my $self = shift;
	my $type = shift;
	my $essential = shift || 0;
	my $return_object_too = shift || 0;
	my $civ;
	my $cname;
	for my $t (@{$self->sorted_constraint_objects}) {
#		my $t = $self->constraint($i);
		if (lc($t->attr("type")) eq lc($type)){
			$civ = $t->lp_row ;
			$cname = $t->id;
			last;
		}
	}
	print STDERR "No constraint of type '$type' found\n" and exit (1) if ($essential and not defined $civ);
	return $return_object_too ? ($civ, $cname) : $civ;
}

sub find_special_activity {
	my $self = shift;
	my $type = shift;
	my $essential = shift || 0;
	my $civ;
	for my $t (@{$self->sorted_activity_objects}) {

		if (lc($t->attr("type")) eq lc($type)){
			$civ = $t->lp_column ;
			last;
		}
	}
	print STDERR "No activity of type '$type' found\n" and exit (1) if ($essential and not defined $civ);
	return $civ;
}
sub find_special_constraints {
	my $self = shift;
	my $type = shift;
	my $essential = shift || 0;
	my $civ;
	my $ct = 0;
	my $cname;
	for my $i ($self->sorted_constraints) {
		my $t = $self->constraint($i);
		if (lc($t->attr("type")) eq lc($type)){
			$civ = $t->lp_row unless (defined $civ);
			$cname = $t unless (defined $cname);
			$ct += 1;
		}
	}
	print STDERR "No constraint of type '$type' found\n" and exit (1) if ($essential and not defined $civ);
	return $ct, $civ;
}
sub find_special_activities {
	my ($self,$type,$essential) = @_;
	$essential = 0 unless (defined $essential);
	my $civ;
	my $ct = 0;
	for my $i (@{$self->sorted_activity_objects}) {
		my $t = $self->activity($i);
		if (lc($t->attr("type")) eq lc($type)){
			$civ = $t->lp_column unless (defined $civ);
			$ct += 1;
		}
	}
	print STDERR "No activity of type '$type' found\n" and exit (1) if ($essential and not defined $civ);
	return $ct, $civ;
}
sub get_cfg_list {
    my $s = $_[0]->config_entry($_[1]);
    return @$s if (ref $s eq "ARRAY");
    my $list; ;
    eval {
	$list = MpmasQLFunctionLanguage->translate_and_interprete ($s, {}); 
    };
    croak "Error: when interpreting cfg entry $_[1]\n$@\n" if $@;
    croak "Interpretation of cfg entry $_[1] returned empty list!\n" unless (@$list) ;
    return @$list;
}
sub get_cfg_list_empty_ok {
    my $s = $_[0]->config_entry($_[1]);
    return @$s if (ref $s eq "ARRAY");
    return () unless (defined $s);
    my $list; ;
    eval {
	$list = MpmasQLFunctionLanguage->translate_and_interprete ($s, {}); 
    };
    croak "Error: when interpreting cfg entry $_[1]\n$@\n" if $@;
    return @$list;
}
sub set_exchanges {
	$Exchanges = $_[1];
}
sub set_number_of_exchanges {
	$Number_of_exchanges = $_[1];
}
sub get_exchanges {
	return $Exchanges;
}
sub get_number_of_exchanges {
	return $Number_of_exchanges;
}
sub delim {
	if ($configs->{"_INPUT_DELIMITERS"}) {
		return $_[1]
	}
	return "";
}
sub get_skip_comments { return $nocommented;}
sub skip_comments { $nocommented = 1;}

sub set_strict_sorting { $strictlySorted = $_[1];}
sub strict_sorting { return $strictlySorted;}

sub setMemUsageObj { $mu = $_[1];}
sub getMemUsageObj { return $mu;}
sub getStartTime { return $starttime};


sub create {}; # nullify SimpleObject constructor





sub blank_file {
	$_[0]->{InputBlocks}->clear;	

}
## subs to be adapted only if necessary
sub extension {
	return ".dat";
}

sub extension_cm {
	return ".txt";
}

sub leftmargin {
	return "\t\t";
}

sub priority{
	return $_[0]->{priority};
}
sub file_suffix {
	return $_[0]->{file_suffix};
}
sub argument {
	return $_[0]->{argument};
}



sub new {
	my ($class,$priority, $argument , $file_suffix) = @_;
	my $self = {};
	$self->{InputBlocks} = SimpleObjectRegistry->create();
	$self->{priority} = $priority;
	my $id = $class;
	if (defined $argument) {
		$id .= "_".$argument;
		$self->{argument} = $argument;
	}
	$self->{id} = $id;
	$self->{file_suffix} = "$file_suffix" if (defined $file_suffix);
	
	bless $self, $class;
	return $self;
}

sub add_block {
	$_[0]->{InputBlocks}->add_objects(@_[1..$#_]);
}

sub write {
	my ($self,$mode,$cur,$valuetab) = @_;
	#print "in Inputfile: $self,$mode,$cur, $valuehash\n";
	my $out;		
	
	my $fn = $self->full_filename($mode);
	open($out, ">", $fn ) or croak "Cannot write to $fn: $!\n";
	print "\e[K \r";
	print "Writing $fn...\r";
	my @SortedBlocks = sort {$a->priority <=> $b->priority } $self->{InputBlocks}->object_list;

	for my $j (@SortedBlocks ) {
		$j->write($out, $mode, $self->leftmargin, $cur,$valuetab);
	}

	#print "..done!\n";
	close ($out);
	
	return $fn;
}

sub full_filename_old {
    my ($self, $dir, $mn, $f, $ext) = @_;
    my $fn = $dir.$mn."_".$f .$ext;
    return $fn;
}

sub full_filename {
    my ($self, $mode) = @_;
    my $dir = $self->outdir();
	my $ext = $self->extension();
	my $mn = $self->mname();
	
	if ($mode == 1) {
		$dir = $self->outdir_cm();
		$ext = $self->extension_cm();
	}
    
    my $fn = $dir.$mn."_". $self->filename() .$ext;
    return $fn;
}
sub make_typemap_activities {
	my ($self) = @_;
	for my $i ($ActivityRegistry->object_list() ) {
		my $t = $i->attr("type");
		
		if (exists $typeMapActivities{ $t }) {
			push @{ $typeMapActivities{$t} }, $i;
		}
		else {
			$typeMapActivities{ $t } = [( $i)];
		}	
	}
}
sub make_typemap_constraints {
	my ($self) = @_;
	for my $i ($ConstraintRegistry->object_list() ) {
		my $t = $i->attr("type");
		
		if (exists $typeMapConstraints{ $t }) {
			push @{ $typeMapConstraints{$t} }, $i;
		}
		else {
			$typeMapConstraints{ $t } = [( $i)];
		}	
	}
}
sub get_constraints_of_type {
	my ($self, $type) = @_; 
	make_typemap_constraints () unless( %typeMapConstraints ) ;
	return $typeMapConstraints{ $type } 
}
sub get_activities_of_type {
	my ($self, $type) = @_; 
	make_typemap_activities () unless( %typeMapActivities ) ;
	return $typeMapActivities{ $type } 
}
sub get_constraints_matching_pattern {
	my ($self, $pattern) = @_;
	my @constraintlist;
	for my $i ($ConstraintRegistry->object_list() ) {
		if ($i->id() =~ /$pattern/) {
			push @constraintlist, $i;
		}
	}
	 
	return \@constraintlist;
}
sub get_activities_matching_pattern {
	my ($self, $pattern) = @_;
	my @activitylist;
	for my $i ($ActivityRegistry->object_list() ) {
		if ($i->id() =~ /$pattern/) {
			push @activitylist, $i;
		}
	}
	 
	return \@activitylist;
}

## Implement for specific file

sub filename {
	return "Testfile";
}
sub required {
	return 1;
}

sub prepare_shared {
	#Implement if new file does preparations which are relevant for other files as well
	return 1;
}

sub prepare_special {
	#Implement for new file
	return 1;
}

1;
