#!/usr/local/bin/perl

###############################################################################
# Program     : AddFCSRuns
# Author      : Eric Deutsch <edeutsch@systemsbiology.org>
# $Id$
#
# Description : This program that allows users to
#               compare the number of proteins/peptides found in
#               two or more experiments.
#
# SBEAMS is Copyright (C) 2000-2005 Institute for Systems Biology
# This program is governed by the terms of the GNU General Public License (GPL)
# version 2 as published by the Free Software Foundation.  It is provided
# WITHOUT ANY WARRANTY.  See the full description of GPL terms in the
# LICENSE file distributed with this software.
#
###############################################################################


###############################################################################
# Set up all needed modules and objects
###############################################################################
use strict;
use Getopt::Long;
use FindBin;
use Alcyt;
use lib "$FindBin::Bin/../../lib/perl";
use vars qw ($sbeams $sbeamsMOD $q $current_contact_id $current_username $current_project_id $PROG_NAME $USAGE %OPTIONS $QUIET $VERBOSE $DEBUG $TESTONLY
             $TABLE_NAME $PROGRAM_FILE_NAME $CATEGORY $DB_TABLE_NAME
             @MENU_OPTIONS);

use SBEAMS::Connection qw($q);
use SBEAMS::Connection::Settings;
use SBEAMS::Connection::Tables;

use SBEAMS::Cytometry;
use SBEAMS::Cytometry::Settings;
use SBEAMS::Cytometry::Tables;

$sbeams = new SBEAMS::Connection;
$sbeamsMOD = new SBEAMS::Cytometry;
$sbeamsMOD->setSBEAMS($sbeams);
$sbeams->setSBEAMS_SUBDIR($SBEAMS_SUBDIR);


#use CGI;
#$q = new CGI;


###############################################################################
# Set program name and usage banner for command like use
###############################################################################
$PROG_NAME = $FindBin::Script;
$USAGE = <<EOU;
Usage: $PROG_NAME [OPTIONS] key=value key=value ...
Options:
  --verbose n         Set verbosity level.  default is 0
  --quiet             Set flag to print nothing at all except errors
  --debug n           Set debug flag

 e.g.:  $PROG_NAME [OPTIONS] [keyword=value],...

EOU

#### Process options
unless (GetOptions(\%OPTIONS,"verbose:s","quiet","debug:s","testonly")) {
  print "$USAGE";
  exit;
}

$VERBOSE = $OPTIONS{"verbose"} || 0;
$QUIET = $OPTIONS{"quiet"} || 0;
$DEBUG = $OPTIONS{"debug"} || 0;
$TESTONLY = $OPTIONS{"testonly"} || 0;
if ($DEBUG) {
  print "Options settings:\n";
  print "  VERBOSE = $VERBOSE\n";
  print "  QUIET = $QUIET\n";
  print "  DEBUG = $DEBUG\n";
  print "  TESTONLY = $TESTONLY\n";
}


###############################################################################
# Set Global Variables and execute main()
###############################################################################
main();
exit(0);


###############################################################################
# Main Program:
#
# Call $sbeams->Authenticate() and exit if it fails or continue if it works.
###############################################################################
sub main {

  #### Do the SBEAMS authentication and exit if a username is not returned
  exit unless ($current_username = $sbeams->Authenticate(
    #connect_read_only=>1,
    #allow_anonymous_access=>1,
    permitted_work_groups_ref=>['Cytometry_user','Cytometry_admin','Admin'],
  ));


  #### Read in the default input parameters
  my %parameters;
  my $n_params_found = $sbeams->parse_input_parameters(
    q=>$q,parameters_ref=>\%parameters);
  #$sbeams->printDebuggingInfo($q);

  #### Display the page header
  $sbeamsMOD->display_page_header();

  #### Decide what action to take based on information so far
  $parameters{action} = '' unless (defined($parameters{action}));
  if ($parameters{action} eq "REFRESH") {
    printEntryForm(ref_parameters=>\%parameters);
  } elsif ($parameters{action}) {
    processEntryForm(ref_parameters=>\%parameters);
  } else {
    printEntryForm(ref_parameters=>\%parameters);
  }

  #### Display the page footer
  $sbeamsMOD->display_page_footer();

} # end main



###############################################################################
# printEntryForm
###############################################################################
sub printEntryForm {
  my %args = @_;


  #### Process the arguments list
  my $ref_parameters = $args{'ref_parameters'}
    || die "ref_parameters not passed";
  my %parameters = %{$ref_parameters};


  #### Define some generic varibles
  my ($i,$element,$key,$value,$line,$result,$sql);


  #### Define some variables for a query and resultset
  my %resultset = ();
  my $resultset_ref = \%resultset;
  my (%url_cols,%hidden_cols,%max_widths,$show_sql);


  #### Read in the standard form values
  my $apply_action=$parameters{'action'} || $parameters{'apply_action'} || '';
  my $TABLE_NAME = $parameters{'QUERY_NAME'};


  #### Set some specific settings for this program
  my $CATEGORY="Add FCS Runs";
  $TABLE_NAME="CY_AddFCSRuns" unless ($TABLE_NAME);
  ($PROGRAM_FILE_NAME) =
    $sbeamsMOD->returnTableInfo($TABLE_NAME,"PROGRAM_FILE_NAME");
  my $base_url = "$CGI_BASE_DIR/$SBEAMS_SUBDIR/$PROGRAM_FILE_NAME";


  #### Get the columns and input types for this table/query
  my @columns = $sbeamsMOD->returnTableInfo($TABLE_NAME,"ordered_columns");
  my %input_types = 
    $sbeamsMOD->returnTableInfo($TABLE_NAME,"input_types");


  #### Read the input parameters for each column
  my $n_params_found = $sbeams->parse_input_parameters(
    q=>$q,parameters_ref=>\%parameters,
    columns_ref=>\@columns,input_types_ref=>\%input_types);


  #### Display the user-interaction input form
  $sbeams->display_input_form(
    TABLE_NAME=>$TABLE_NAME,CATEGORY=>$CATEGORY,apply_action=>$apply_action,
    PROGRAM_FILE_NAME=>$PROGRAM_FILE_NAME,
    parameters_ref=>\%parameters,
    input_types_ref=>\%input_types,
  );
  

  #### Display the form action buttons
  $sbeams->display_form_buttons(TABLE_NAME=>$TABLE_NAME);


} # end printEntryForm



###############################################################################
# processEntryForm
###############################################################################
sub processEntryForm {
  my %args = @_;


  #### Process the arguments list
  my $ref_parameters = $args{'ref_parameters'}
    || die "ref_parameters not passed";
  my %parameters = %{$ref_parameters};

  #### Define some generic varibles
  my ($i,$element,$key,$value,$line,$result,$sql);


  #### Read in the standard form values
  my $apply_action=$parameters{'action'} || $parameters{'apply_action'} || '';
  my $TABLE_NAME = $parameters{'QUERY_NAME'};


  #### Set some specific settings for this program
  my $CATEGORY="Add FCS Runs";
  $TABLE_NAME="CY_AddFCSRuns" unless ($TABLE_NAME);
  ($PROGRAM_FILE_NAME) =
    $sbeamsMOD->returnTableInfo($TABLE_NAME,"PROGRAM_FILE_NAME");
  my $base_url = "$CGI_BASE_DIR/$SBEAMS_SUBDIR/$PROGRAM_FILE_NAME";


  #### Get the columns and input types for this table/query
  my @columns = $sbeamsMOD->returnTableInfo($TABLE_NAME,"ordered_columns");
  my %input_types = 
    $sbeamsMOD->returnTableInfo($TABLE_NAME,"input_types");


  #### Read the input parameters for each column
  my $n_params_found = $sbeams->parse_input_parameters(
    q=>$q,parameters_ref=>\%parameters,
    columns_ref=>\@columns,input_types_ref=>\%input_types);


  #### Obtain information about the current user
  $current_username = $sbeams->getCurrent_username;
  $current_contact_id = $sbeams->getCurrent_contact_id;

 
#  $current_work_group_id = $sbeams->getCurrent_work_group_id;
#  $current_work_group_name = $sbeams->getCurrent_work_group_name;
  $current_project_id = $sbeams->getCurrent_project_id;
#  $current_project_name = $sbeams->getCurrent_project_name;


  #### Check for missing required information
  my @required_columns = 
    $sbeamsMOD->returnTableInfo($TABLE_NAME,"required_columns");
  if (@required_columns) {
    my $error_message;
    foreach $element (@required_columns) {
      $error_message .= "<LI> You must provide a <B>$element</B>."
        unless $parameters{$element};
    }

    if ($error_message) {
      $sbeams->printIncompleteForm($error_message);
      return 0;
    }
  }


  #### Verify that the directory exists and is readable
  $parameters{filepath} .+ '/'  if $parameters{filepath} !~ /\/$/;
  unless (-d $parameters{filepath}) {
    my $error_message = qq"
      <LI> The filepath specified '$parameters{filepath}' could
      not be found or read by the server.
      Please make sure that the directory is spelled correctly and the
      directory is spelled correctly and that the permissions are set
      so that the SBEAMS server can read them.
    ";
    $sbeams->printIncompleteForm($error_message);
    return 0;
  }


  #### Get the contents of the directory
  my @dir_contents = getDirListing($parameters{filepath});


  #### Loop over all the files
  foreach $element (@dir_contents) {

    #### If if this is a .fcs file, process it
    if ($element =~ /\.fcs$/) {
      print "Processing FCS file '$element'<BR>\n";
      my $fcs_run_id = getFCSRun(
        filename=>$element,
        project_id=>$parameters{project_id},
      );

      #### If it already exists, just say so for now
      if ($fcs_run_id > 0) {
        print "- This file has already been loaded<BR>\n";

      #### If not, add it
      } else {
        my $result = addFCSRun(
          parameters_ref=>\%parameters,
          filename=>$element,
        );

        #### If successful, copy the file to a safe, predictable place
        if ($result) {
          my $project_name = getProjectName($parameters{project_id});
          my $cmd = "/usr/bin/cp -p $parameters{filepath}/$element ".
            "/net/cytometry/archive/$current_username/".
            "$project_name/";
          print "- $cmd<BR>\n";
          #system($cmd);
        }

      }

    }

  }


} # end processEntryForm



###############################################################################
# getProjectName
###############################################################################
sub getProjectName {
  my $project_id = shift || die("ERROR: No project_id specified");

  #### Get the name of this project_id
  my $sql = qq"
    SELECT project_tag
      FROM $TB_PROJECT
     WHERE project_id = '$project_id'
       AND record_status != 'D'
  ";

  my ($project_name) = $sbeams->selectOneColumn($sql);

  return $project_name;

}



###############################################################################
# getFCSRun
###############################################################################
sub getFCSRun {
  my %args = @_;

  my ($i,$element,$key,$value,$line,$result,$sql);

  #### Process the arguments list
  my $filename = $args{'filename'};
  my $project_id = $args{'project_id'};

  #### Find the fcs_run_id for this project and file
  $sql = qq"
    SELECT fcs_run_id
      FROM $TBCY_FCS_RUN
     WHERE project_id = '$project_id'
       AND filename = '$filename'
  ";

  my @fcs_run_ids = $sbeams->selectOneColumn($sql);
  my $n_fcs_run_ids = scalar(@fcs_run_ids);

  #### If this one is not yet in database
  if ($n_fcs_run_ids == 0) {
    return 0;
  }

  #### If more than one row comes back, this is very bad
  if ($n_fcs_run_ids > 1) {
    die("EROR: Expected 1 row but got $n_fcs_run_ids from\n$sql\n");
  }

  #### Return PK
  return $fcs_run_ids[0];

} # end getFCSRun



###############################################################################
# addFCSRun
###############################################################################
sub addFCSRun {
  my %args = @_;

  my ($i,$element,$key,$value,$line,$result,$sql);

  #### Process the arguments list
  my $parameters_ref = $args{'parameters_ref'};
  my $filename = $args{'filename'};

  my %parameters = %{$parameters_ref};


  #### Read the fcs file header
  my $header = readFCSFileHeader(
    filepath=>$parameters{filepath},
    filename=>$filename,
  );

  my %rowdata = (
    project_id => $parameters{project_id},
    organism_id => $parameters{organism_id},
    project_designator => $header->{PROJ},
    sample_name => $header->{CELLS},
    filename => $filename,
    original_filepath => $parameters{filepath},
    n_data_points => $header->{TOT},
    run_date=>$header->{DATE},
    fcs_run_description=>$header->{COM},
  );


  #### INSERT the fcs_run into the database
  my $fcs_run_id = $sbeams->updateOrInsertRow(
    insert=>1,
    table_name=>$TBCY_FCS_RUN,
    rowdata_ref=>\%rowdata,
    PK_name=>'fcs_run_id',
    return_PK=>1,
    verbose=>$VERBOSE,
    testonly=>$TESTONLY,
  );


  #### INSERT all the header parameters
  my $counter = 1;
  while ( ($key,$value) = each %{$header}) {
    my %row = (
      fcs_run_id => $fcs_run_id,
      key_order => $counter,
      parameter_key => $key,
      parameter_value => $value,
    );

    my $fcs_run_id = $sbeams->updateOrInsertRow(
      insert=>1,
      table_name=>$TBCY_FCS_RUN_PARAMETER,
      rowdata_ref=>\%row,
      verbose=>$VERBOSE,
      testonly=>$TESTONLY,
    );

    $counter++;

  }


  return 1;

} # end addFCSRun



###############################################################################
# readFCSFileHeader
###############################################################################
sub readFCSFileHeader {
  my %args = @_;

  #### Process the arguments list
  my $filepath = $args{'filepath'};
  my $filename = $args{'filename'};
  $filepath .= "/" if ($filepath !~ /\/$/);
  

  my @header = read_fcs_header($filepath.$filename);
  my @keyValue = get_fcs_keywords($filepath.$filename,@header);
  my %keyValueHash = get_fcs_key_value_hash(@keyValue);
  
   #### Read header from file
  my %header;
  $header{PROJ} = $keyValueHash{'$PROJ'};
  $header{TOT} =  $keyValueHash{'$TOT'};
  $header{CELLS} = $keyValueHash{'$CELLS'};
  $header{DATE} = $keyValueHash{'$DATE'};
  $header{COM} = $keyValueHash{'$SMNO'}."\n".$keyValueHash{'$CYT'}."\n".  $keyValueHash{'$P4N'}."\n". $keyValueHash{'$P5N'};
  
  return \%header;

} # end readFCSFileHeader



###############################################################################
# getDirectoryListing
###############################################################################
sub getDirListing {
  my $dir = shift;
  my @files;

  opendir(DIR, $dir)
    || die "[${PROG_NAME}:getDirListing] Cannot open $dir: $!";
  @files = grep (!/(^\.$)|(^\.\.$)/, readdir(DIR));
  closedir(DIR);

  return sort(@files);
}



###############################################################################
# evalSQL: Callback for translating global table variables to names
###############################################################################
sub evalSQL {
  my $sql = shift;

  return eval "\"$sql\"";

} # end evalSQL