#!/usr/local/bin/perl ############################################################################### # Program : main.cgi # Author : Martin Korb # $Id$ # # Description : This script authenticates the user, and then # displays the opening access page. # and everything else # # 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. # ############################################################################### ############################################################################### # Get the script set up with everything it will need ############################################################################### use strict; use Benchmark; use Text::Wrap; use Data::Dumper; use GD::Graph::xypoints; use vars qw ($q $sbeams $sbeamsMOD $PROGRAM_FILE_NAME $current_contact_id $current_username); use lib qw (../../lib/perl); #use CGI; use CGI::Carp qw(fatalsToBrowser croak); use SBEAMS::Connection qw($q); use SBEAMS::Cytometry::Alcyt; use SBEAMS::Cytometry; use SBEAMS::Cytometry::Settings; use SBEAMS::Cytometry::Tables; use SBEAMS::Connection::TabMenu; use SBEAMS::Connection::Settings; use SBEAMS::Connection::DBConnector; use SBEAMS::Connection::Tables; use SBEAMS::Connection::TableInfo; use SBEAMS::Connection::Utilities; #$q = new CGI; $sbeams = new SBEAMS::Connection; $sbeamsMOD = new SBEAMS::Cytometry; $sbeamsMOD->setSBEAMS($sbeams); ############################################################################### # Global Variables ############################################################################### my $VERBOSE; my $TESTONLY; $PROGRAM_FILE_NAME = 'main.cgi'; my $INTRO = '_displayIntro'; my $START = '_start'; my $ERROR = '_error'; my $PROCESSFILE = '_processFile'; my $GETGRAPH = '_getGraph'; my $CELL = '_processCells'; my $GETANOTHERGRAPH = '_getAnotherGraph'; my $SPECRUN = '_specifyRun'; my $IMMUNOLOAD = '_immunoLoad'; my (%indexHash,%editorHash,%inParsParam); #possible actions (pages) displayed my %actionHash = ( $INTRO => \&displayIntro, $START => \&displayMain, $PROCESSFILE => \&processFile, $GETGRAPH => \&getGraph, $CELL => \&processCells, $ERROR => \&processError, $GETANOTHERGRAPH => \&getAnotherGraph, $SPECRUN => \&specifyRun, $IMMUNOLOAD => \&immunoLoad ); my $attributeSql = "select measured_parameters_id, measured_parameters_name from $TBCY_MEASURED_PARAMETERS"; my %attributeHash = $sbeams->selectTwoColumnHash($attributeSql); main(); exit(0); ############################################################################### # Main Program: # # Call $sbeams->Authentication and stop immediately if authentication # fails else continue. ############################################################################### sub main { #### Do the SBEAMS authentication and exit if a username is not returned exit unless ($current_username = $sbeams->Authenticate( #connect_read_only=>1, permitted_work_groups_ref=>['Cytometry_user','Cytometry_admin','Admin','Cytometry_readonly'], allow_anonymous_access=>1, )); #### Read in the default input parameters my %parameters; my $n_params_found = $sbeams->parse_input_parameters( q=>$q,parameters_ref=>\%parameters); #$sbeams->printDebuggingInfo($q); #### Process generic "state" parameters before we start $sbeams->processStandardParameters(parameters_ref=>\%parameters); ; #### Print the header, do what the program does, and print footer # normal handling for anything else $sbeamsMOD->display_page_header(); handle_request(ref_parameters=>\%parameters); $sbeamsMOD->display_page_footer(); } # end main ############################################################################### # Show the main welcome page ############################################################################### sub handle_request { 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); my @rows; #### Show current user context information $sbeams->printUserContext(); $current_contact_id = $sbeams->getCurrent_contact_id(); #### Get information about the current project from the database $sql = qq~ SELECT UC.project_id,P.name,P.project_tag,P.project_status, P.PI_contact_id FROM $TB_USER_CONTEXT UC INNER JOIN $TB_PROJECT P ON ( UC.project_id = P.project_id ) WHERE UC.contact_id = '$current_contact_id' ~; @rows = $sbeams->selectSeveralColumns($sql); my $project_id = ''; my $project_name = 'NONE'; my $project_tag = 'NONE'; my $project_status = 'N/A'; my $PI_contact_id = 0; if (@rows) { ($project_id,$project_name,$project_tag,$project_status,$PI_contact_id) = @{$rows[0]}; } my $PI_name = $sbeams->getUsername($PI_contact_id); #### If the current user is not the owner, the check that the #### user has privilege to access this project if ($project_id > 0) { my $best_permission = $sbeams->get_best_permission(); #### If not at least data_reader, set project_id to a bad value $project_id = -99 unless ($best_permission > 0 && $best_permission <=40); } #### Get all the experiments for this project my $action = $parameters{'action'}; print qq~ ~; my $sub = $actionHash{$action} || $actionHash{$INTRO}; if ($sub ) { #print some info about this project #only on the main page =comment if ($sub eq $actionHash{$INTRO}) { print qq~

You are successfully logged into the $DBTITLE - $SBEAMS_PART system. This module is designed as a repository for cytometry data.

Please choose your tasks from the menu bar on the left.

TO ENTER A NEW CYTOMETRY RUN:

This system is still under active development. Please be patient and report bugs, problems, difficulties, suggestions to mkorb\@systemsbiology.org.

~; } print qq~

Current Project: $project_name

Status: $project_status
Project Tag: $project_tag
Owner: $PI_name
Access Privileges: [View/Edit]
~ if ($action eq '_displayIntro' || !$action) ; foreach my $p (keys %parameters) { print "
$p === $parameters{$p}
"; } =cut if ($sub eq $actionHash{$INTRO}) { if (($action eq '_displayIntro' || !$action) and ($parameters{searchCombo} != 1 and $parameters{wildcardSample} != 1)) { my $tabmenu = SBEAMS::Connection::TabMenu->new( cgi => $q, # paramName => 'mytabname', # uses this as cgi param # maSkin => 1, # If true, use MA look/feel # isSticky => 0, # If true, pass thru cgi params # boxContent => 0, # If true draw line around content # labels => \@labels # Will make one tab per $lab (@labels) ); #### Add the individual tab items $tabmenu->addTab( label => 'Current Project', helptext => 'View details of current Project' ); $tabmenu->addTab( label => 'My Projects', helptext => 'View all projects owned by me' ); $tabmenu->addTab( label => 'Accessible Projects', helptext => 'View projects I have access to' ); $tabmenu->addTab( label => 'Recent Resultsets', helptext => "View recent $SBEAMS_SUBDIR resultsets" ); ########################################################################## #### Buffer to hold content. my $content; #### Conditional block to exec code based on selected tab #### Print out details on the current default project if ( $tabmenu->getActiveTabName() eq 'Current Project' ){ my $project_id = $sbeams->getCurrent_project_id(); if ( $project_id ) { $content = $sbeams->getProjectDetailsTable( project_id => $project_id ); # $content .= getCurrentProjectDetails( # ref_parameters => \%parameters, # ); } #### Print out all projects owned by the user } elsif ( $tabmenu->getActiveTabName() eq 'My Projects' ){ $content = $sbeams->getProjectsYouOwn(); #### Print out all projects user has access to } elsif ( $tabmenu->getActiveTabName() eq 'Accessible Projects' ){ $content = $sbeams->getProjectsYouHaveAccessTo(); #### Print out some recent resultsets } elsif ( $tabmenu->getActiveTabName() eq 'Recent Resultsets' ){ $content = $sbeams->getRecentResultsets() ; } #### Add content to tabmenu (if desired). $tabmenu->addContent( $content ); #### Display the result print $tabmenu->asHTML(); print qq~

This system and this module in particular are still under active development.
Please be patient and report bugs, problems, difficulties, as well as suggestions to mkorb\@systemsbiology.org


~; # checkGO(); } } checkGO(); #### If the project_id wasn't reverted to -99, display i`nformation about it if ($project_id == -99) { print " \n"; } else { &$sub(ref_parameters=>\%parameters,project_id=>$project_id); } #could not find a sub } else { print_fatal_error("Could not find the specified routine: $sub"); } print "
You do not have access to this project. Contact the owner of this project if you want to have access.
"; } ####---------------------------------------------------------------------------------- sub displayIntro { my %args = @_; #### get the project id my $project_id = $args{'project_id'} || die "project_id not passed"; my $ref_parameters = $args{'ref_parameters'} || die "ref_parameters not passed"; my %parameters = %{$ref_parameters}; # my ($sampleID, $sortEntityID, $runDate); =comment foreach my $k (keys %parameters) { print "$k ==== $parameters{$k}
"; } =cut my @clauseArray; my $queryClause; if($parameters{searchCombo}) { my $sampleID = $parameters{sampleID}; my $sortEntityID = $parameters{sortEntityID}; my $runDate = $parameters{dates}; my $tissueID = $parameters{tissueTypeID}; push @clauseArray, "fcs_run_id in ($sampleID)" if defined($sampleID); push @clauseArray, "sort_entity_id in ($sortEntityID)" if defined($sortEntityID); push @clauseArray, "fcs_run_id in ($runDate)" if defined($runDate); push @clauseArray, "tissue_type_id in ($tissueID)" if defined ($tissueID); $queryClause = join ' and ', @clauseArray if @clauseArray;; } my $organismSql = qq~ select organism_id,organism_name from $TB_ORGANISM ~; my %organismHash = $sbeams->selectTwoColumnHash($organismSql); my $flag = 0; $flag = 1 if (! $parameters{noShow}); my $sql = "select fcs_run_id,Organism_id , project_designator, sample_name, filename, run_date from $TBCY_FCS_RUN where project_id = $project_id and showFlag = $flag order by project_designator, run_date"; my $immunoStainName = $parameters{loadImmuno}; my $immunoStainFiles = $parameters{immunoSampleName}; my $immunoStainSql = "select fcs_run_id,Organism_id , project_designator, sample_name, filename, run_date from $TBCY_FCS_RUN where project_id = $project_id and sample_Name like '%$immunoStainFiles%' order by project_designator, run_date"; my $wildCardGuess = $parameters{sampleGuess}; my $wildCard = $parameters{wildcardSample}; my $wildCardSql = "select fcs_run_id,Organism_id , project_designator, sample_name, filename, run_date from $TBCY_FCS_RUN where project_id = $project_id and sample_Name like '%$wildCardGuess%' order by project_designator, run_date"; my $searchComboSql = "select fcs_run_id,Organism_id , project_designator, sample_name, filename, run_date from $TBCY_FCS_RUN where project_id = $project_id and $queryClause order by project_designator, run_date"; my $moreSql = "select count(*) from $TBCY_FCS_RUN fr where fr.project_id = $project_id and fr.showFlag = 0"; my $moreCount = ($sbeams->selectOneColumn($moreSql))[0]; my @rows; @rows = $sbeams->selectSeveralColumns($sql); @rows = $sbeams->selectSeveralColumns($immunoStainSql) if ($immunoStainName)and do { $parameters{noShow} = 1}; ; @rows = $sbeams->selectSeveralColumns($wildCardSql) if ( $wildCard) and do { $parameters{noShow} = 1};; @rows = $sbeams->selectSeveralColumns($searchComboSql) if ($parameters{searchCombo}) and do { $parameters{noShow} = 1}; my %hashFile; my $count = 1; if (@rows) { print "

"; print qq~ Search for a Specific Cytometry Run?

Current Cytometry data for this project


~ if( ! $parameters{search}); print ""; foreach my $row(@rows) { my ($fcsID,$organismID, $projectDes, $sampleName, $fileName, $runDate) = @{$row}; $runDate =~ s/^(.*?)\s0.*$/$1/; my @array; # print "$count == $projectDes == $organismID == ,$sampleName == $fileName === $runDate
"; $projectDes = uc($projectDes); push @array,( $sampleName, $organismHash{$organismID},$fileName, $runDate); $hashFile{$projectDes}->{$fcsID}->{'Sample Name'} = $sampleName; $hashFile{$projectDes}->{$fcsID}->{Organism} = $organismHash{$organismID}; $hashFile{$projectDes}->{$fcsID}->{'File Name'} = $fileName; $hashFile{$projectDes}->{$fcsID}->{'Run Date'} = $runDate; $hashFile{$projectDes}->{$fcsID}->{'Create Graph'} = $fileName; $count++; } foreach my $key (keys %hashFile) { print ""; print ""; foreach my $id (keys %{$hashFile{$key}}) { print qq ~~; } } print $q->start_form; print qq~ ~ ; print qq ~~ if (! $parameters{noShow}); print qq~\n"; } elsif ($parameters{search} == 1) { print "\n"; anotherQuery(); # print $q->start_form; # print qq~ ~ ; # print qq~~; # print $q ->end_form; } } #### Finish the table print qq~
Project Designator: $key
Sample NameOrganismFile NameRun DatePlot Data
$hashFile{$key}->{$id}->{'Sample Name'} $hashFile{$key}->{$id}->{Organism} $hashFile{$key}->{$id}->{'File Name'} $hashFile{$key}->{$id}->{'Run Date'} Plot Data
~ if (! $parameters{noShow} and $moreCount > 0); # print qq~
~ if $parameters{noShow}; print qq ~~ if ($parameters{noShow}); print $q->end_form; if ($parameters{search}) { anotherQuery(); } } else { if (! $parameters{search}) { print "


This project contains no Cytometry Data



Sorry, your Query returned no Fcs Run

~; =comment ########################################################################## #### Print out all projects owned by the user $sbeams->printProjectsYouOwn() if $sbeams->getCurrent_contact_id(); ########################################################################## #### Print out all projects user has access to $sbeams->printProjectsYouHaveAccessTo() if $sbeams->getCurrent_contact_id(); ########################################################################## #### Print out some recent resultsets $sbeams->printRecentResultsets() if $sbeams->getCurrent_contact_id(); ########################################################################## #### Finish with a disclaimer =cut return; } # end showMainPage sub processFile { my %args = @_; #### Process the arguments list my $ref_parameters = $args{'ref_parameters'} || die "ref_parameters not passed"; my %parameters = %{$ref_parameters}; my %resultset = (); my $resultset_ref = \%resultset; my %parameters = %{$ref_parameters}; =comment foreach my $k (keys %parameters) { print "$k ==== $parameters{$k}
"; } =cut my $fileQuery = "select original_filepath +'/' + filename as completeFile from $TBCY_FCS_RUN where fcs_run_id = $parameters{fileID}"; my @row = $sbeams->selectOneColumn($fileQuery); my $infile = $row[0]; #'/net/db/projects/StemCell/FCS/102403/'.$parameters{fileName}; my ($fileName) =$infile =~ /^.*\/(.*)$/; # my @header = read_fcs_header($infile); # my @keywords = get_fcs_keywords($infile,@header); # my %values = get_fcs_key_value_hash(@keywords); print "Measured parameters:
"; print "Choose the X and Y coordinates
"; my $parameterQuery = "select measured_parameters_name, mp.measured_parameters_id from $TBCY_MEASURED_PARAMETERS mp join $TBCY_FCS_RUN_PARAMETERS frp on mp.measured_parameters_id = frp.measured_parameters_id where frp.fcs_run_id = $parameters{fileID}"; my %cytoParameters = $sbeams->selectTwoColumnHash($parameterQuery); my $databaseUpdate = 0; print qq~
~; print qq~ \n~; print qq~ ~; print $q->start_form (-onSubmit=>"return checkRadioButton($databaseUpdate)", -target => "_blank"); foreach my $key (keys %cytoParameters) { my $upperKey = uc($key); print qq~ \n~; } print qq~ ~; print qq~ ~ ; print qq ~~; print qq ~~; print qq~
x-axisy- axis
$upperKey~; print qq~ $upperKey
~; print $q->end_form; } #----------------------------------------------------------------------------- sub specifyRun { my %args = @_; #### Process the arguments list my $ref_parameters = $args{'ref_parameters'} || die "ref_parameters not passed"; my %parameters = %{$ref_parameters}; # foreach my $k (keys %parameters) # { # print "$k ==== $parameters{$k}
"; # } my $project_id = $args{'project_id'}; my $entitySql = "select se.sort_entity_id,sort_entity_name from $TBCY_SORT_ENTITY se join $TBCY_FCS_RUN rf on se.sort_entity_id = rf.sort_entity_id where rf.project_id = $project_id group by sort_entity_name,se.sort_entity_id order by sort_entity_name"; my $entityOption = $sbeams->buildOptionList($entitySql, "Selected","MULTIOPTIONLIST"); my $sampleNameSelect = "select fcs_run_id, sample_Name from $TBCY_FCS_RUN rf where rf.project_id = $project_id order by sample_name"; my %sampleNameHash = $sbeams->selectTwoColumnHash($sampleNameSelect); my %sampleNameIDHash; foreach my $key (keys %sampleNameHash) { my $name = $sampleNameHash{$key}; push @{$sampleNameIDHash{$name}} , $key } my $sampleNameOption = $sbeams->buildOptionList($sampleNameSelect, "Selected", "MULTIOPTIONLIST"); my $tissueSelect = "select tt.tissue_type_id, tissue_type_name from $TBCY_TISSUE_TYPE tt join $TBCY_FCS_RUN rf on tt.tissue_type_id = rf.tissue_type_id where rf.project_id = $project_id group by tissue_type_name, tt.tissue_type_id order by tissue_type_name"; my $tissueOption = $sbeams->buildOptionList($tissueSelect, "Selected", "MULTIOPTIONLIST"); my $dateSelect = "select fcs_run_id, run_date from $TBCY_FCS_RUN rf where rf.project_id = $project_id order by run_date"; my %dateHash = $sbeams->selectTwoColumnHash($dateSelect); my %dateIDHash; foreach my $key (keys %dateHash) { my $date = $dateHash{$key}; $date =~ s/^(.*?)00:.*$/$1/; $date =~ s/\s+//g; push @{$dateIDHash{$date}} , $key } my %modeDateHash; foreach my $keys (keys %dateHash) { $keys =~ s/^(.*?)00:.*$/$1/; $keys =~ s/\s+//g; $modeDateHash{$keys} = $keys; } #this is one form print $q->start_form; print qq~

Enter part or all of a Sample Name~; print qq~ ~ ; print qq ~~; print qq ~~; print qq~~; print $q->end_form; #this is the second form print qq ~
~; print $q->start_form (-onSubmit=>"return checkForm2()", -target => "_blank"); #print $q->start_form; print qq~ Select none, one or multiple SampleNames~; print qq~ Select none, one or multiple Sort Entities~; print qq~ Select none, one or multiple Tissue Types ~; foreach my $key (sort keys %dateIDHash){ my $element = join ', ', @{$dateIDHash{$key}}; print qq~