#!/usr/local/bin/perl 
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################


# $Id: owl_map_blocks.pm,v 1.4 1999/08/18 11:43:30 dn1 Exp $
# $Log: owl_map_blocks.pm,v $
# Revision 1.4  1999/08/18 11:43:30  dn1
# *** empty log message ***
#
# Revision 1.3  1998/09/23 08:39:46  dn1
# *** empty log message ***
#
# Revision 1.2  1998/06/24  08:47:56  dn1
# *** empty log message ***
#

require Exporter;

use DBI;

@owl_map_blocks::ISA = qw(Exporter);
@owl_map_blocks::EXPORT = qw(map_blocks);

use Data::Dumper;

package owl_map_blocks;

# DN1
################################################################################
# Map request blocks onto maps                                                 #
################################################################################
# Supply the module with $db_database, $db_user, $db_pass -> for db connection
#                        $select_blocks -> array of blocks-titles to map
#                        $datacollector -> datastructure of blocks and samples
#                        $max_samples   -> the maximum number of samples you want on a plate
#                        $plate_size    -> the plate size (96 or 384)

sub map_blocks {

    my($db_database, $db_user, $db_pass, $select_blocks, $datacollector, $max_samples, $plate_size) = @_;

    #warn "Inside owl_map_blocks.pm -> $db_database, $db_user, $db_pass, $select_blocks, $datacollector, $max_samples, $plate_size \n"; 
    
    # Step 1; to cluster the maps into same PROTOCOL/RUNTYPE batches
    my @clusters = &clusterOrders($select_blocks);

    # here
    my $capture = Data::Dumper::Dumper(@clusters);
    #warn "looking at $capture\n";
    
    #my $capture = Data::Dumper::Dumper($datacollector);
    #warn $capture;

    my $set;
    my $nummapsused = 0;
    my @maps_used = ();
    my @map_structure = ();

    my $COLOUR;
    my $lastblock = 'None';
    my $blockchange = 0;

    # We'll use temporary $ID_MAPLATE values for the time being.
    # These can be changed to proper $ID_MAPLATE values from the database
    # When the maps have beed selected for submission to the database.
    my $ID_MAPPLATE = 0;
    if ($plate_size == 384){$max_samples = $max_samples+96;}

    my $no_plate_needed_flag = 0;

    foreach $set (@clusters) {

	my $it_counter;
	############################################
	#my $capture = Data::Dumper::Dumper($set);
	#warn "yup ! $capture; \n";
	my $it = ($#{$set->[1]} +1);
	#warn "number of items in $set->[0] --->  $it \n"; 
	############################################

	# For each new PROTOCOL/RUNTYPE we need to start a new map
	#warn $set;
	#warn "******* New cluster-set -> Need a  -> $set->[0] <- plate $set->[1][0] \n";
	# get a new MAPPLATE for each clusterset we are looking at...

	
	$ID_MAPPLATE++;
	$nummapsused++;
	push @maps_used, $ID_MAPPLATE;
	

	# We now need to add the contents of our blocks to the map
	# If we run out of space on the map we should get a new map
	# How much space should be on the map >?< ($max_samples $plate_size)
	

	# Are we looking at a 96 or 384 well-plate >?<
	my $ID_MAP;
	if ($plate_size == 96){
	    $ID_MAP = 1;
	}
	if ($plate_size == 384){
	    $ID_MAP = 97;
	}

	my $next;
	my $total = $#{$datacollector};
	#warn "TOTAL -> $total \n";
	foreach $next (0 .. $total){
	    my $test = $datacollector->[$next]->{block};
	    
	    

	    ###################################################
	    #my $capture = Data::Dumper::Dumper($select_blocks);
	    #warn "yup ! $capture; \n";
	    ###################################################
	    
	    
	    my $hit = 0;
	    
	    if ($test =~ /$set->[0]/){
		# ok, so this block matches the right set but is it
		# on our blocks 'to-do' list >?<
		my $tester;
		foreach $tester (@$select_blocks){
		    #warn "tester -> $tester \n";
		    if ($tester eq $test){
			#warn "A hit ! \n";
			$hit = 1;
		    }
		}

		next unless ($hit == 1);

		$it_counter++;
		$COLOUR = 'cyan4';

		$samples_this_block = ($#{$datacollector->[$next]->{contents}} +1);
		my $each;
		my $samples_count = 1;
		foreach $each (0 .. $#{$datacollector->[$next]->{contents}}){
		    my $ID_FREQUEST = $datacollector->[$next]->{contents}->[$each]->[0];
		    my $BLOCKNAME = $datacollector->[$next]->{block};

		    ################################################################## 
		    # TEMPORARY SIMPLE COLOUR-CODING RULE...
		    ##################################################################
		    # If this is a different block to last-time; change the colour
		    # ie. colour will alternate for different blocks
		    my $thisblock = $BLOCKNAME;
		    if ($thisblock ne $lastblock){
			if ($blockchange == 0) {
			    $blockchange++;
			}elsif ($blockchange == 1){
			    $blockchange--;
			}
		    }
		    $lastblock = $thisblock;  
		    if ($blockchange == 0){
			$COLOUR = "cyan4";
			#warn "colour is now $colour \n";
		    }
		    if ($blockchange == 1){
			$COLOUR = "cyan3";
			#warn "colour is now $colour \n";
		    }

		    # populate a new data-structure which will contain mapping information
		    # ID_MAPPLATE(which plate is the sample on ?)
		    # ID_MAP(the position on the plate ? ; for 96 wells this is 1-96)
		    # ID_FREQUEST(which sample are we talking about ?)


		    #my @list = ($ID_MAPPLATE, $ID_MAP, $ID_FREQUEST, $BLOCKNAME);
		    my @list = ($ID_MAPPLATE, $ID_MAP, $ID_FREQUEST, $BLOCKNAME, $COLOUR);

		    #warn @list;
		    my $hash = {
			"plate_type" => "$set->[0]",
			"contents" => [@list]
			};
 		    push @map_structure, $hash;
		    # Do we need a new plate yet >?<

		    #warn "***************************************************************************\n";
		    #warn "samples_count -> $samples_count samples_this_block -> $samples_this_block \n";
		    #warn "ID_MAP -> $ID_MAP max_samples -> $max_samples \n";
		    #warn "USING MAP ->$ID_MAPPLATE \n";
		    #warn "IT -> $it IT_COUNTER -> $it_counter \n";
		    #warn '$ID_MAP >= $max_samples) && ($samples_count != $samples_this_block';
		    #warn "Colour for this block is -> $COLOUR \n";
		    #warn "***************************************************************************\n";

		    if ($ID_MAP >= $max_samples){
			# we need a new plate
                        # BUT not if this is the end of a block
			if ($samples_count != $samples_this_block){
			    # This is NOT the end of a block
			    $ID_MAPPLATE++;
			    $nummapsused++;
			    push @maps_used, $ID_MAPPLATE;
			    if ($plate_size == 96) {
				$ID_MAP = 1;
			    } elsif ($plate_size == 384){
				$ID_MAP = 97;
			    }
			    $samples_count++;
			} else {
			    #warn "EVENT !  EVENT ! EVENT ! EVENT ! EVENT ! \n";
			    #warn "We have reached the end of the plate limit \n";
			    #warn "This is also the end of a block \n";
			    if ($plate_size == 96) {
				$ID_MAP = 1;
			    } elsif ($plate_size == 384){
				$ID_MAP = 97;
			    }
			    
			    # unless this is the last sample in the last block
			    # of a set of blocks...
			    # how many blocks are in the set of blocks >?<
			    unless ($it == $it_counter){
				#warn "it is not it_counter !!!!!!!!!!!!!! \n";
				#warn " so I am starting a new plate. \n";
				$ID_MAPPLATE++;
				$nummapsused++;
				push @maps_used, $ID_MAPPLATE;
				$samples_count = 1;
				
			    }

			    # PROBLEM IS THAT THIS WILL START A NEW PLATE
			    # EVEN IF THIS BLOCK SET IS FINISHED
			    # ...we need to trap this event



			}

		    } else {
			#no; go to the next well on the same plate
			$samples_count++;

			# This is the only place we increment $ID_MAP
			$ID_MAP++;
						
		    }

		}
	    
	    }
	}
	#warn "******* End of set *******\n";
    }

    #... and what have we got >?<
    
    #warn "%%%%%%%%%%%%%%% map_structure contains the following %%%%%%%%%%%%%%%%%%%\n";
    #my $capture2 = Data::Dumper::Dumper(@map_structure);
    #warn $capture2;


    # so how many maps did we get >?<
    #warn "We used $nummapsused maps. \n";
    
    return(\@map_structure, \@maps_used);

    
}				# end of sub map_blocks

sub clusterOrders {
    #warn "now inside clusterOrders \n";
    my ($orders) = @_;

    my $capture = Data::Dumper::Dumper($orders);
    #warn "looking at $capture\n";

    #warn @$orders;

    my $order;
    my %rx;
    my $reaction;
    my @clusters;
    foreach $order (@$orders) {

	#$reaction = (split(/_/,$order))[3];
	$reaction = (split(/__/,$order))[3];

	#warn "debug -> $reaction \n";

	if (! defined $rx{$reaction}) {
	    $rx{$reaction} = [ $order ];
	} else {
	    push(@{$rx{$reaction}}, $order);
	}
    }
    
    # Create data structure for return
    foreach $reaction ( keys %rx ) {
	push(@clusters,[$reaction , $rx{$reaction}]);
    }

    return @clusters;

    
}				# end of sub clusterOrders



1;

