#!/usr/bin/perl

######################################################
# STAINFINDER PROGRAM Version 1.1
# Author : Wijan Prapong 
# Modified: 9/30/2003 by Chih Long Liu
# This is currently the most up-to-date Stainfinder,
# as of 2/15/2005.
#
# This program takes input from a TreeView file and 
# allows users to view various stains simultaneously
######################################################

use strict;
use CGI qw/:standard/;
use CGI::Carp qw (fatalsToBrowser);

$|=1;

my $query = new CGI;

my $submit = $query->param('Display checked images');
my $submit2 = $query->param('Reset to default');
my $submit3 = $query->param('Clear all checkboxes');
my $submit4 = $query->param('Check all checkboxes');

my @imageSize = (1504,1440); #default image size of Bliss jpgs
my $resizeFactor = $query->param('resizeFactor');
my $screenSize = $query->param('screenSize');
my @cookieValue = ($resizeFactor, $screenSize); 
my @cookieParams = $query->cookie('cookieParams');
my @cookieAntibodies = $query->cookie('cookieAntibodies');
my @defaultParams = @cookieParams || ('12.5%','1024x768');

my $uniqID = $query->param('uniqid') || die "A uniqid must be passed into the Stain Finder.  Check your Tree View settings.\n";

my %abAndJpgHash;

my @cdtAntibodies = split("!",$uniqID);
my $dirname = shift(@cdtAntibodies);
my $jpgName = shift(@cdtAntibodies);
$jpgName =~ s/.jpg//g;
my @jpgNames = split(/\*/,$jpgName);
my $fpNum = shift(@cdtAntibodies);
my ($fpFile, @fpVars, @paraffinFile);

# The $mainDir and $webDir variables are used to allow
# easy updates if the scans should ever move to a different location
# Note - to enable a single instance of Stainfinder to handle multiple
# datasets, the URL string is now modified to include the dataset name.
# The dataset name is expected to be the very first item in the
# URL string.

#my $mainDir = '/share/tissue/archive/scans/'.$dirname.'/Composites/';
my $mainDir = '/share/ukulele/www-data/html/TISSUE/'.$dirname.'/';
my $webDir = '/TISSUE/'.$dirname.'/';

#--Read paraffin file data exported from FileMaker Pro--#
opendir (DIR, "$mainDir") || die "Cannot open directory $mainDir: $!\n";
@paraffinFile = grep /par_block/, readdir(DIR);
closedir (DIR);

if (@paraffinFile && $fpNum){
    open(FILE, "$mainDir"."@paraffinFile") || die "can't open file: $!";
    while (<FILE>){
	@fpVars = split("\t", $_); #expects tab delimited file
	$fpFile = shift(@fpVars);
	if ($fpFile == $fpNum){
	    $fpFile = join (" | ", @fpVars);
	    last;
	    close FILE;
	}else{
	    $fpFile = "";
	}
   }
    close FILE;
}


my (@allAntibodyNames, @goodAntibodyNames, @badAntibodyNames);

my (@AoA, @AoH);
foreach (@jpgNames){
    push (@AoA, [ split("_", $_) ]); 
}

# my @jpgParts = split ("_", $jpgName);
# my $sector = $jpgParts[0];
# my $tissueArray = $jpgParts[1];
# my $column = $jpgParts[2];
# my $row = $jpgParts[3];

#--These variables are not actually used by the program--#
# my $slice = $jpgParts[4];
# my $blissCode = $jpgParts[5];
# my $scannerPos = $jpgParts[6];


@allAntibodyNames = &GetAntibodyNamesFromDirectories;

if(@cookieAntibodies){
    @cdtAntibodies = @cookieAntibodies;
}
&CheckAntibodyNames;

my @antibodyChoices = $query->param('antibodyChoices');
@antibodyChoices = sort(@antibodyChoices);


#---------------------Cookie Setup----------------------#
my $setCookie1 = $query->param('setCookie1');
my $deleteCookie1 = $query->param('deleteCookie1');
my $setCookie2 = $query->param('setCookie2');
my $deleteCookie2 = $query->param('deleteCookie2');

my ($cookie1, $cookie2);
if ($setCookie1){ # set cookie if box is checked 
    $cookie1 = $query->cookie(-name=>'cookieParams',
			      -value=>\@cookieValue,
			      -expires=>'+10y'); 
}elsif($deleteCookie1){ 
    $cookie1 = $query->cookie(-name=>'cookieParams',
			      -value=>\@cookieParams,
			      -expires=>'-10y');
    $query->param(-name=>'resizeFactor',
		  -value=>'12.5%');
    $query->param(-name=>'screenSize',
		  -value=>'1024x768');
}

if ($setCookie2){ # set cookie if box is checked 
    $cookie2 = $query->cookie(-name=>'cookieAntibodies',
			      -value=>\@antibodyChoices,
			      -expires=>'+10y'); 
}elsif($deleteCookie2){ 
    $cookie2 = $query->cookie(-name=>'cookieAntibodies',
			      -value=>\@cookieAntibodies,
			      -expires=>'-10y'); 
}

if (($setCookie1 || $deleteCookie1) && ($setCookie2 || $deleteCookie2)){
    print $query->header(-cookie=>[$cookie1, $cookie2]);
}elsif($setCookie1 || $deleteCookie1){
    print $query->header(-cookie=>$cookie1);
}elsif($setCookie2 || $deleteCookie2){
    print $query->header(-cookie=>$cookie2);
}else{
    print $query->header;
}

print $query->start_html("Stain Finder");
#print "@jpgNames"."<br>";
#print "@allAntibodyNames".br;
#print "$AoA[0][3]".br;

#---------------------Form Setup----------------------#
print $query->start_form();    
print "Display initial images at ";
print $query->popup_menu(-name=>'resizeFactor',
			 -value=>['12.5%', '25%', '50%', '100%'],
                         -default=>$defaultParams[0]);
print "of their original size<br>";

print "Monitor resolution of your computer ";
print $query->popup_menu(-name=>'screenSize',
			 -value=>['640x480',
				  '800x600',
				  '1024x768',
				  '1280x1024',
				  '1600x1024'],
			 -default=>$defaultParams[1]);

print br;
if (!@cookieParams){ # parameter cookie does not exist
    if ($setCookie1){
	print font({-color=>'red'},
		   "A cookie has been set on your computer with
                    the default settings of images at $resizeFactor 
                    and a screen size of $screenSize");
    }else{
	print $query->checkbox(-name=>'setCookie1',
			       -label=>'Save these settings as the default 
                                        on this computer (a cookie will be
                                        set on your computer)');
    }
}else{
    if ($deleteCookie1){
	print font({-color=>'red'},
		   "All cookies have been removed from your computer 
                    and the default settings have been returned to 12.5% 
                    and a screen size of 1024x768");
    }else{
	print $query->checkbox(-name=>'deleteCookie1',
			       -label=>'Remove saved settings from this
                                        computer (Return to defaults of
                                        12.5% and 1024x768)');
    }
}

print br, hr;

$resizeFactor =~ tr/%//d;
my $imageWidth = $imageSize[0] * ($resizeFactor / 100);
my $imageHeight = $imageSize[1] * ($resizeFactor / 100);
$screenSize = substr($screenSize, 0,  index($screenSize, "x"));

print "Show stains from the following antibodies:<br>";
if($submit2){
    print $query->checkbox_group(-name=>'antibodyChoices',
				 -values=>\@allAntibodyNames,
				 -default=>\@goodAntibodyNames,
				 -override=>1,
				 -columns=>4);
}elsif($submit3){
    @goodAntibodyNames=();
    print $query->checkbox_group(-name=>'antibodyChoices',
				 -values=>\@allAntibodyNames,
				 -default=>\@goodAntibodyNames,
				 -override=>1,
				 -columns=>4);
}elsif($submit4){
    @goodAntibodyNames=();
    print $query->checkbox_group(-name=>'antibodyChoices',
				 -values=>\@allAntibodyNames,
				 -default=>\@allAntibodyNames,
				 -override=>1,
				 -columns=>4);
}else{
    if(@cookieAntibodies){
	print $query->checkbox_group(-name=>'antibodyChoices',
				     -values=>\@allAntibodyNames,
				     -default=>\@cookieAntibodies,
				     -override=>1,
				     -columns=>4);
    }else{
	print $query->checkbox_group(-name=>'antibodyChoices',
				     -values=>\@allAntibodyNames,
				     -default=>\@goodAntibodyNames,
				     -columns=>4);	
    }
}

print br;
print $query->hidden(-name=>'uniqid',
		     -value=>$uniqID);

if (!@cookieAntibodies){ # cookie does not exist
    if ($setCookie2){
	print font({-color=>'red'},
		   "A cookie has been set on your computer.  
                    All subsequent displays will default to 
                    the antibodies currently chosen."
		   );
    }else{
	print $query->checkbox(-name=>'setCookie2',
			       -label=>'Save these antibodies as the 
                                        default choices on this computer
                                        (a cookie will be set on your
                                         computer)'
			       );
    }
}else{
    if ($deleteCookie2){
	print font({-color=>'red'},
		   "The cookie with the default antibody choices has 
                    been removed from your computer.");
    }else{
	print $query->checkbox(-name=>'deleteCookie2',
			       -label=>'Remove saved antibody choices from 
                                        this computer (Use antibodies passed
                                        in from the CDT file);');
    }
}

print br;
print $query->submit(-name=>'Display checked images');
print "&nbsp";
print $query->submit(-name=>'Reset to default');
print "&nbsp";
print $query->submit(-name=>'Clear all checkboxes');
print "&nbsp";
print $query->submit(-name=>'Check all checkboxes');


if (@badAntibodyNames){
    my $displayBadNames = join("; ", @badAntibodyNames);
    print br, br;
    print font({-color=>'red'},
	       b('NOTE:').'The following antibodies from the CDT file are 
                           not checked because there were no matching 
                           directories available:'
	       .br
	       .b($displayBadNames)
	       .br);
}

print $query->end_form;


my (@jpgsWithFullPath);
if ($submit){
    &GetFullJpgName(\%abAndJpgHash);
    &CreateTable;
}
print $query->end_html;

#################################################
sub GetAntibodyNamesFromDirectories{
#################################################
# This subroutine checks for directories that match the same sector and
# tissue array as the uniqid that is passed in.  It returns the names of
# all the valid antibodies as determined from the directory structure.

    my (@availableABs, @dirTemp, $abName, $i, $dir, $dirRegExp, $sector, $tissueArray);

    for $i (0 .. $#jpgNames){
	$sector = $AoA[$i][0];
	$tissueArray = $AoA[$i][1];

	$dirRegExp = "C-TA-0*$tissueArray-0*$sector.";
	opendir (DIR,"$mainDir") || die "Cannot open directory $mainDir: $!\n";
	@dirTemp = grep /$dirRegExp/, readdir(DIR);
	closedir (DIR);

	foreach $dir (@dirTemp){
	    $abName = substr($dir, rindex($dir, ".")+1);
	    if ($i == 0){
		push (@availableABs, lc($abName)); #remove lc to make this case-sensitive; mod 1 of 5
	    }
	    $AoH[$i]{lc($abName)} = $dir; #remove lc to make this case-sensitive; mod 2 of 5
	}
    }

    @availableABs = sort @availableABs;
    return @availableABs;

}

#################################################
sub CheckAntibodyNames{
#################################################
# This subroutine is called when antibodies are passed in from the CDT 
# file. It checks the CDT antibody names against the antibody names from
# the directory structure, and splits the CDT antibodies into two arrays 
# of good names and bad names.

    foreach (@cdtAntibodies){ # strip anything that comes after a parentheses
	if(index($_, "(") != -1){
	    $_ = substr($_, 0,  index($_, "("));
	}
    }

    foreach (@cdtAntibodies) {
	if($AoH[0]{lc($_)}) { #remove lc to make this case-sensitive; mod 3 of 5
	    push(@goodAntibodyNames, lc($_));  #remove lc to make this case-sensitive; mod 4 of 5
	}else{
	    push(@badAntibodyNames, lc($_));   #remove lc to make this case-sensitive; mod 5 of 5
	}
    }

}

#################################################
sub GetFullJpgName{
#################################################
# This subroutine takes the chosen antibodies and appends the jpg name 
# to the directory value of the corresponding hash pairs

    my (@directories, $tmpHolder, @jpgTemp, $jpgRegExp, $ab, $i);

    for $i (0 .. $#jpgNames){
	$jpgRegExp = "$AoA[$i][0]"."_"."$AoA[$i][1]"."_"."$AoA[$i][2]"."_"."$AoA[$i][3]"."_";
	foreach $ab (@antibodyChoices){
	    $tmpHolder = $AoH[$i]{$ab};
	    opendir (JPG, "$mainDir"."$tmpHolder") || die "Cannot open directory test $tmpHolder $!\n";
	    @jpgTemp = grep /$jpgRegExp/, readdir(JPG);
	    closedir (JPG);
	    if (@jpgTemp){
		$AoH[$i]{$ab} = $webDir.$tmpHolder."/"."@jpgTemp";
	    }else{
		$AoH[$i]{$ab} = "No image found";
	    }
	    $tmpHolder = undef;
	}
    }
}
    
#################################################
sub CreateTable{
#################################################
# This subroutine takes the jpg names and creates a table in
# HTML for browser display
    
    if($fpNum){	
        print br,b("Slides from FP#$fpNum $fpFile");
    }

    my (@rows, $row);	
    my $numImagesPerRow = int($screenSize/($imageWidth*@jpgNames));
    $numImagesPerRow = 1 if ($numImagesPerRow < 1);

    my $numRows = int(@antibodyChoices/$numImagesPerRow)+1;

    my $i = 0; #number of stains displayed
    my $j = 0; #number of row elements displayed

    while($i < @antibodyChoices){
	$row .= td(&MakeOneStainTable($antibodyChoices[$i]));
	$j++;
	if ($j == $numImagesPerRow){
	    push(@rows, $row);
	    $j = 0;
	    $row = undef;
	}
	$i++;
    }

    #--this section unneeded if filler cells not desired--#
    my $numFillerCells;
    if ($numRows > 1 && @antibodyChoices%$numImagesPerRow){
	$numFillerCells = $numImagesPerRow-(@antibodyChoices%$numImagesPerRow);
    }
    while($numFillerCells > 0){ #if filler cells needed
	$row .= td({-bgcolor=>'silver'},'&nbsp');
	$numFillerCells--;
	if ($numFillerCells == 0){
	    push(@rows, $row);
	    $row = undef;
	}
    }

    push(@rows, $row) if defined $row;
    print table({-cellpadding=>'4',
		 -cellspacing=>'0',
		 -border=>2,
		 -bordercolor=>'black'},
		 Tr([@rows])
		 );

}

#################################################
sub MakeOneStainTable{
#################################################
# This subroutine makes a table that contains one individual
# stain (meaning rows containing image, antibody name, and
# other formatting)

    my ($abName) = @_;
    my (@rows);

    push(@rows, td({-bgcolor=>'black',
		    -colspan=>$#jpgNames+1}, 
		   '&nbsp' ));
    push(@rows, &GetAbNameCell($abName));
    push(@rows, &GetImageCell($abName));
    push(@rows, td({-bgcolor=>'black',
		    -colspan=>$#jpgNames+1}, 
		   '&nbsp' ));

    return table({-border=>1,
		  -bordercolor=>'black'},
		 Tr([@rows])
		 );

}

#################################################
sub GetImageCell{
#################################################
# This subroutine creates a table element containing the image
# or an image not found list if the image is missing

    my ($abName) = @_;
    my ($cell, $i);
    for $i (0 .. $#jpgNames){
	if ($AoH[$i]{$abName} eq "No image found"){
	    $cell .= td({-align=>'CENTER',
			 -valign=>'MIDDLE',
			 -width=>$imageWidth,
			 -height=>$imageHeight},
			'No image found'
			);
	}else{
	    $cell .=  td({-align=>'CENTER'},
			 img {src=>"$AoH[$i]{$abName}",
			      width=>$imageWidth,
			      height=>$imageHeight}
			 );
	}
	
    }
	
    return $cell;
}

#################################################
sub GetAbNameCell{
#################################################
# This subroutine prints the name of the antibody as a clickable
# link within one table data element

    my ($abName) = @_;
    my ($cell, $i);
    for $i (0 .. $#jpgNames){
	if ($AoH[$i]{$abName} eq "No image found"){
	    $cell .= td({-align=>'CENTER',
		       -bgcolor=>'silver'},
		      b($abName)
		      );
	}else{
	    $cell .= td({-align=>'CENTER',
		       -bgcolor=>'silver'},
		      a({-href=>"$AoH[$i]{$abName}",
			 -target=>'_blank'},
			b($abName)
			)
		      );
	}

    }

    return $cell;

}


