#!/usr/bin/perl
package SimpleObjectRegistry;
use strict;
use warnings;

no warnings qw(experimental);
use feature qw(refaliasing);

use SimpleObject;
use Storable qw(dclone store retrieve);
use Data::Dumper;
use Carp qw(cluck croak);

our @ISA = qw(SimpleObject);

sub counter {
	$_[0]->{count};
}

 sub create {
	my $class = shift;
	my $self = {};
	$self->{list} = [];
	$self->{lookup} = {};
	$self->{count} = 0;
	$self->{sorted} = 1;
	bless $self, $class;
 }
 
 sub add_objects {
	my $self = shift;
	$self->{sorted} = 0;
	my @array = @_;
	eval {
		local $SIG{__WARN__}=sub{};
		while (@array) {
			my $co	= shift @array;	
			croak "$co is not a reference\n" unless (ref $co); 	
			my $id = $co->get_attribute("id");
			push @{$self->{list}}, $co;
			$self->{lookup}->{$id} = $#{$self->{list}};
			$self->{count} += 1;
			
		}
	 
	};
	croak $@ if ($@);
 }
  sub add_objects_from_ref {
	my ($self, $arrayref) = @_;
	$self->{sorted} = 0;

	eval {
		local $SIG{__WARN__}=sub{};
		foreach (@$arrayref) {
			my $co	= $_;	
			croak "$co is not a reference\n" unless (ref $co); 	
			my $id = $co->get_attribute("id");
			push @{$self->{list}}, $co;
			$self->{lookup}->{$id} = $#{$self->{list}};
			$self->{count} += 1;
			
		}
	 
	};
	croak $@ if ($@);
 }
 
 sub add_or_replace_objects {
	my $self = shift;
	my @array = @_;
	eval {
		local $SIG{__WARN__}=sub{};
		while (@array) {
			my $co	= shift @array;	
			croak "$co is not a reference\n" unless (ref $co); 	
			my $id = $co->get_attribute("id");
			if (exists $self->{lookup}->{$id} ) {
				my $index = $self->{lookup}->{$id};
				$self->{list}->[$index] = $co;
			}	
			else {
				push @{$self->{list}}, $co;
				$self->{lookup}->{$id} = $#{$self->{list}};
				$self->{count} += 1;
			}
		}
		
	};
	croak $@ if ($@);
 }
 sub delete_objects {
	my $self = shift;
	while (@_) {
		my $co	= shift @_;	
		my $id = $co->get_attribute("id");
		next unless (exists $self->{lookup}->{$id});
		my $index = $self->{lookup}->{$id};
		my @lowerpart = @{$self->{list}}[0 .. $index -1];
		my @upperpart = @{$self->{list}}[$index +1 .. $self->{count}-1];
		$self->{list} = \@lowerpart;
		push @{$self->{list}}, @upperpart;
		delete $self->{lookup}->{$id};
		for my $i (@upperpart) {
		      my $idi = $i->get_attribute("id");
		      $self->{lookup}->{$idi} -= 1;
		}
		$self->{count} -= 1;
	}
 }
sub clear {
	my $self = shift;
	$self->{list} =[];
	$self->{lookup} = {};
	$self->{count} = 0;
	1;
}
sub shift_object {
	my $self = shift;
	my $shiftedobject = shift @{$self->{list}};
	my $id = $shiftedobject->get_attribute("id");
	delete $self->{lookup}->{$id};
	$self->{count} -= 1;
	foreach my $i (keys %{$self->{lookup}}) {
		$self->{lookup}->{$id} -= 1;
	}
	return $shiftedobject;
}

 sub get_object_by_id {
	my $index = $_[0]->{lookup}->{$_[1]};
	if (defined $index) {
		return $_[0]->{list}[$index] ;
	} else {
		return undef;
	}
 }
 sub get_object_by_position {
    croak "Error in SimpleObjectRegistry::get_object_by_position: Position ", $_[1]  ," does not exist in array.\n" if ($_[1] > $#{ $_[0]->{list}  });
	return $_[0]->{list}[ $_[1] ] ;
 }
 sub get_position_by_id {
	my $index = $_[0]->{lookup}->{$_[1]};
	if (defined $index) {
		return $index ;
	} else {
		return undef;
	}
 }
  sub get_position_of_object {
    
	my $index = $_[0]->{lookup}->{$_[1]->id};
	if (defined $index) {
		return $index ;
	} else {
		return undef;
	}
 }
 
 
 
sub object_list {
	my $self = shift;
	return @{$self->{list}};
}
sub object_list_ref {
	return $_[0]->{list};
}
sub objects_hash_by_id {
	my ($self) = @_;
	my @result = map { ($_->id()  => $_ )} @{$self->{list}};
	return \@result
}
sub object_list_by_attribute {
	my $self = shift;
	my $attribute = shift;
	my $hashofarrays= {};
	
	for my $i ( @{$self->{list}} ) {
		my $group = $i->get_attribute($attribute);
		push @{$hashofarrays->{$group}}, $i;
	};
	return $hashofarrays;
}
sub object_list_if_attribute {
	my $self = shift;
	my $attribute = shift;
	my $condition = shift;
	my @array;
	
	for my $i ( @{$self->{list}} ) {
		my $x = $i->get_attribute($attribute);
		my $teststring = $x." ".$condition;
		push @array, $i if (eval($teststring));
	};
	return @array;
}

sub save {
	my $self = shift;
	my $file = shift;
	store $self, $file || warn "Could not store!";
	1;
}
sub recreate {
	my $class = shift;
	my $file = shift;
	my $self = retrieve ($file) ;
	croak ("Error: Could not retrieve data from $file!\n") unless (defined $self);
	bless $self, $class;
	return $self;
}
sub summarize_attribute {
	my $self = shift;
	my $attribute = shift;
	my $aggregate = shift;
	my $result;
	if ($aggregate eq "total") {
		$result = 0;
		for my $i ($self->object_list()) {
			
			$result += $i->get_attribute($attribute);
		}
	}
	elsif ($aggregate eq "groupcount") {
		for my $i ($self->object_list()) {
			my $group = $i->get_attribute($attribute);
			$result->{$group} = 0 unless (exists $result->{$group});
			$result->{$group} += 1;
		}
	}
	
	return $result;
}
sub save_attribute_table_as_ascii {
	my $self = shift;
	my $fname = shift;
	my @attributes = @_;
	print "Saving $fname...\n";
	open (my $fh, ">", $fname) or die "$!";
	print $fh join("\t", ("id", @attributes) )."\n" ;
	for my $i (sort {$a->get_attribute("id") cmp $b->get_attribute("id")} @{$self->{list}}) {
		print $fh $i->get_attribute("id");
		for my $j (@attributes) {
			print $fh "\t";
			print $fh $i->get_attribute($j);
		}
		print $fh "\n";
	}
	close ($fh);
	return 1;
}
sub sort_objects {

    my $self = shift;
    my $sortfunc = shift;
    #Note:@_ not now only contains remaining arguments, which will be passed on to sortfunc
    my @array ;
    \@array =  $self->{list}; #alias the list array into an array variable so that sort is using inplace sorting! # requires perl 5.22
	
	@array = sort { &$sortfunc($a, $b, @_) } @array;
	
	#$self->{list} = [sort { &$sortfunc($a, $b) } @{$self->{list}}];
	
	#reset the lookup
	$self->{lookup} = undef;
	my $count = 0;
	$self->{lookup} = {map { $_->id()  =>  $count++  } @array};
    #$self->{lookup} = map { $_->id()  =>  $count++  } @{$self->{list}};
    #foreach(@{$self->{list}}) {
    #    $self->{lookup}->{ $_->id() } = $count++;
    #}


    $self->{sorted} = 1;
}
sub resort_by_array_ref {
    my ($self, $ref_array_of_sorted_ids) = @_;

	$self->{list} = [map { 
	                      $self->get_object_by_id($_)
	  
	                    } @{$ref_array_of_sorted_ids}];
	
	#reset the lookup
	$self->{lookup} = undef;
	my $count = 0;
	$self->{lookup} = { map { $_->id()  =>  $count++  } @{$self->{list}} };
    
    $self->{sorted} = 1;
}

sub is_sorted {
    return $_[0]->{sorted};
}

1;
