#!/usr/bin/perl
package CtUtilities;
use strict;
use warnings;
use POSIX;
use List::Util qw /first/;
#use DBI;
use Carp;
use Data::Dumper;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(round_to get_unique trim is_in_list is_in_string_list is_in_numeric_list stub_in_list offset_of_cell_neighbor fisher_yates_shuffle determine_class_by_upperbound determine_class_by_lowerbound queryhash extqueryhash strip_sql numbers_robust_to_sorting cartesian nice_hash_dump stamp_time);
sub round_to {
	my $input = $_[0];
	my $base = $_[1];
	my $tinput = $input  / $base;
	return $base * (  $tinput - floor($tinput) >= .5  ? ceil($tinput)  : floor($tinput) );
}
# Function to get a list of the different entries of an array (similar entries only once
sub get_unique
{
	my %all;
	$all{$_}=0 for @_;
	return (keys %all);
}
# Perl trim function to remove whitespace from the start and end of the string
sub trim
{
	my $string = $_[0];
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

sub is_in_list {
	my $test = $_[0];
	my $arrayref = $_[1];
	croak ("Invalid array reference passed to is_in_list(): $arrayref\n") unless (ref($arrayref) eq "ARRAY");
	defined( (not defined $test or $test =~ /\D/) ?  first { $test eq $_ } @$arrayref  :  first {  $test == $_ } @$arrayref  );
}
sub is_in_string_list {
	my $test = $_[0];
	my $arrayref = $_[1];
	croak ("Invalid array reference passed to is_in_string_list(): $arrayref\n") unless (ref($arrayref) eq "ARRAY");
	defined( first { $test eq $_ } @$arrayref   );
	
	
}
sub is_in_numeric_list {
	my $test = $_[0];
	my $arrayref = $_[1];
	croak ("Invalid array reference passed to is_in_numeric_list(): $arrayref\n") unless (ref($arrayref) eq "ARRAY");
	defined( first { $test == $_ } @$arrayref   );
	
	
}
sub stub_in_list {
	my $test = $_[0];
	my $arrayref = $_[1];
	first { $test =~ /^$_/ } @$arrayref   ;
}


sub offset_of_cell_neighbor {
	my $level = shift;
	my $cell = shift;
	my $n = 2 ** (2+$level);
	my $s = $n / 4;
	my $x;
	my $y;
	if ($cell < $s) {
		$y = -1* $level;
		$x = int $cell - $s/2;
	}
	elsif ($cell >= $s and $cell < 2 * $s) {
		$x = $level;
		$y = int $cell - 1.5 * $s;
	}
	elsif ($cell >= 2* $s and $cell < 3 * $s) {
		$y = $level;
		$x = int  2.5 * $s - $cell;
	}
	elsif ($cell >= 3* $s and $cell < 4 * $s) {
		$x = -1 * $level;
		$y = int 3.5 *$s - $cell;
	}
	else {
		return undef;
	}
	return ($x,$y);
}

sub pi () {
	4* atan2 1,1
}

sub fisher_yates_shuffle {
		my $deck = shift;  # $deck is a reference to an array
		return unless @$deck; # must not be empty!
		my $i = @$deck;
		while (--$i) {
			my $j = int rand ($i+1);
			@$deck[$i,$j] = @$deck[$j,$i];
		}
		return @$deck;
}

sub determine_class_by_lowerbound {
	my $category_hash = shift;
	my $value = shift;
	my %cumul;
	for my $k (keys	%{ $category_hash } ) {
		my $i = $category_hash->{$k};
		$cumul{$i} = $k;
	}
	my $category;
	for my $lb (sort{$b <=> $a} keys %cumul) {
		if ($lb <= $value) {
		$category = $cumul{$lb};
		last;
		}
	}
	return $category;
}
sub determine_class_by_upperbound {
	my $category_hash = shift;
	my $value = shift;
	my %cumul;
	for my $k (keys	%{ $category_hash } ) {
		my $i = $category_hash->{$k};
		$cumul{$i} = $k;
	}
	my $category;
	for my $ub (sort{$a <=> $b} keys %cumul) {
		if ($ub >= $value) {
		$category = $cumul{$ub};
		last;
		}
	}
	return $category;
}

sub strip_sql {
	my $string = shift;
	$string =~ s/^\s*#sql\s*\(\s*"//;
	$string =~ s/"\s*\)\s*$//;
	return $string;
}

#Function returning a hash for either a tablename or a SQL-Query 
				
sub queryhash {
	require DBI;
	#expects input string, key field name
	# if it does not get a key field name it will interprete the first 1 or 2 columns column as a key
	my $dbh = $_[0];
	my $m1 = $_[1];
	my $m2 = $_[2];
	
	my $rt;
	if (defined $m2 and $m2 =~ /^\s*\w+\s*$/ ) {
	
		if ($m1 =~ /^\s*#sql\(\s*"\s*SELECT/) {
			
			$m1 =~ s/^\s*#sql\("//;
			$m1 =~ s/"\)\s*$//;
			eval {
				  local $SIG{__WARN__}=sub{};
				$rt = $dbh->selectall_hashref($m1, $m2);
			};
			croak $@ if $@;
		}
		elsif ($m1 =~ /^\s*\w+\s*$/) {
			eval {
				local $SIG{__WARN__}=sub{};
				my $m3 = "SELECT * FROM $m1";
				$rt = $dbh->selectall_hashref($m3, $m2)	;
			};
		        croak $@ if $@;
		}else{
			croak "Error!!!: Not a valid table name or SQL Statement: $m1";
		}
		
	}else {
	
		my $m4;
		if ($m1 =~ /#sql\("SELECT/) {
			$m1 =~ s/^#sql\("//;
			$m1 =~ s/"\)\s*$//;
			eval {
				local $SIG{__WARN__}=sub{};
				$m4 = $dbh->selectall_arrayref($m1);
			};
			croak $@ if $@;
		}elsif ($m1 =~/^s*\w+\s*$/) {
				my $m3 = "SELECT * FROM $m1";
				 $m4 = $dbh->selectall_arrayref($m3);
		}else{
				$rt = undef;
				return $rt;	
		}
		for my $j (@{$m4}){
			if ($#{$j} == 1) {
				my $sc = ${$j}[0];
				my $sv = ${$j}[1];
				$rt->{$sc} = $sv; 

			}
			if ($#{$j} == 2) {
				my $sc = ${$j}[0];
				my $sv = ${$j}[1];
				my $svl = ${$j}[2];
				$rt->{$sc}->{$sv} = $svl; 

			}
			if ($#{$j} >= 3) {

				my $sc = ${$j}[0];
				my $sv = ${$j}[1];
				$sc =~ s/^(\d)*$/x$1/;
				$sv =~ s/^(\d)*$/x$1/;
				for my $sss (2..$#{$j}) {
					my $svl = ${$j}[$sss];
					$rt->{$sc}->{$sv}->[$sss-2] = $svl ; 
				}
			}

		}

	} #END OUTER IF		
	return $rt;
} #END queryhash

sub extqueryhash {
	require DBI;
			#like queryhash second option, but for 3 or 4 index fields
			#expects input string, number of index fields
	# if it does not get a valid key field name it will interprete the first row as a key
	my $dbh = $_[0];
	my $m1 = $_[1];
	my $m2 = $_[2];
	
	my $rt;
	my $m4;
	if ($m1 =~ /#sql\("SELECT/) {
		$m1 =~ s/^#sql\("//;
		$m1 =~ s/"\)\s*$//;
		$m4 = $dbh->selectall_arrayref($m1);
	}elsif ($m1 =~/^s*\w+\s*$/) {
			my $m3 = "SELECT * FROM $m1";
				$m4 = $dbh->selectall_arrayref($m3);
	}else{
			$rt = undef;
			print "Error: $m1 neither a query nor a table name!!\n";
			return $rt;	
	}
	
	for my $j (@{$m4}){
		if ($#{$j} < $m2) {
			die "Query $m1 results in a table lacking necessary columns";
		}
		if ($m2 == 3) {

			my $sc = ${$j}[0];
			my $sv = ${$j}[1];
			my $sw = ${$j}[2];
			$sc =~ s/^(\d*)$/x$1/;
			$sv =~ s/^(\d*)$/x$1/;
			$sw =~ s/^(\d*)$/x$1/;
			for my $sss (3..$#{$j}) {
				my $svl = ${$j}[$sss];
				$rt->{$sc}->{$sv}->{$sw}->[$sss-3] = $svl ; 
			}
		}
		if ($m2 == 4) {

			my $sc = ${$j}[0];
			my $sv = ${$j}[1];
			my $sw = ${$j}[2];
			my $sx = ${$j}[3];
			$sc =~ s/^(\d*)$/x$1/;
			$sv =~ s/^(\d*)$/x$1/;
			$sw =~ s/^(\d*)$/x$1/;
			$sx =~ s/^(\d*)$/x$1/;
			for my $sss (4..$#{$j}) {
				my $svl = ${$j}[$sss];
				$rt->{$sc}->{$sv}->{$sw}->{$sx}->[$sss-4] = $svl ; 
			}
		}

	}

	return $rt;

} #END extqueryhash

sub numbers_robust_to_sorting {
	my $string = shift;
	my $transformed = "";
	while ($string =~ s/^([^\d]*)(\d+)//) {
		$transformed .= $1 . sprintf("%07d", $2);
	};
	$transformed .= $string;

}
sub decimals_robust_to_sorting {
	my $string = shift;
	my $transformed = "";
	while ($string =~ s/^([^\d]*)(\d+|\d*.\d+)//) {
		$transformed .= $1 . sprintf("%011.3f", $2);
	};
	$transformed .= $string;

}

sub cartesian {
#http://www.perlmonks.org/?node_id=7366
    my @C = map { [ $_ ] } @{ shift @_ };
    	
    foreach (@_) {
        my @A = @$_;

        @C = map { my $n = $_; map { [ @$_, $n  ] } @C } @A;
    }

    return @C;
}
sub nice_hash_dump {
	my $hashref = $_[0];
	my $string;
	foreach (sort {$a cmp $b } keys %$hashref) {
		      my $show = Dumper($hashref->{$_});
		      $show =~ s/,\n\s*/, /sg;
		      $show =~ s/^\$VAR1\s*=//;
		      $string .= " $_ = $show";
	}
	return $string;
}

sub stamp_time {
	my ($starttime, $where) = @_;
	my $totaltime = (time - $starttime);
	my $minutes = int ($totaltime / 60);
	my $seconds = $totaltime % 60;
	print "Reached $where after $minutes:".sprintf("%02d",$seconds)." minutes.\n\n";
}
1;
