#!/usr/local/bin/perl ############################################################################### # Program : ShowTICPlot # Author : Eric Deutsch # $Id$ # # Description : This CGI program displays the requested TIC spectrum # for a provided fraction # # 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 lib "$FindBin::Bin/../../lib/perl"; use vars qw ($sbeams $sbeamsMOD $q $current_contact_id $current_username $PROG_NAME $USAGE %OPTIONS $QUIET $VERBOSE $DEBUG $DATABASE ); use SBEAMS::Connection qw($q); use SBEAMS::Connection::Settings; use SBEAMS::Connection::Tables; use SBEAMS::Proteomics; use SBEAMS::Proteomics::Settings; use SBEAMS::Proteomics::Tables; $sbeams = new SBEAMS::Connection; $sbeamsMOD = new SBEAMS::Proteomics; $sbeamsMOD->setSBEAMS($sbeams); $sbeams->setSBEAMS_SUBDIR($SBEAMS_SUBDIR); #use CGI; #$q = new CGI; ############################################################################### # Define global variables if any and execute main() ############################################################################### main(); ############################################################################### # Main Program: # # If $sbeams->Authenticate() succeeds, print header, process the CGI request, # print the footer, and end. ############################################################################### sub main { #### Do the SBEAMS authentication and exit if a username is not returned exit unless ($current_username = $sbeams->Authenticate( permitted_work_groups_ref=>['Proteomics_user','Proteomics_admin', 'Proteomics_readonly'], #connect_read_only=>1, #allow_anonymous_access=>1, )); #### Print the header, figure and do what the user want, and print footer $sbeamsMOD->printPageHeader(); processRequests(); $sbeamsMOD->printPageFooter(); } # end main ############################################################################### # Process Requests # # Test for specific form variables and process the request # based on what the user wants to do. ############################################################################### sub processRequests { $current_username = $sbeams->getCurrent_username; $current_contact_id = $sbeams->getCurrent_contact_id; # Enable for debugging if (0==1) { print "Content-type: text/html\n\n"; my ($ee,$ff); foreach $ee (keys %ENV) { print "$ee =$ENV{$ee}=
\n"; } foreach $ee ( $q->param ) { $ff = $q->param($ee); print "$ee =$ff=
\n"; } } #### Only one view available for this program printEntryForm(); } # end processRequests ############################################################################### # Print Entry Form ############################################################################### sub printEntryForm { #### Define some general variables my ($i,$element,$key,$value,$sql); $sbeams->printUserContext(); #### Define the parameters that can be passed by CGI my @possible_parameters = qw ( fraction_id proteomics_experiment_id ); my %parameters; #### Read in all the passed parameters into %parameters hash foreach $element (@possible_parameters) { $parameters{$element}=$q->param($element); } my $apply_action = $q->param('apply_action'); #### Resolve the keys from the command line if any my ($key,$value); foreach $element (@ARGV) { if ( ($key,$value) = split("=",$element) ) { $parameters{$key} = $value; } else { print "ERROR: Unable to parse '$element'\n"; return; } } #### verify that needed parameters were passed unless ($parameters{fraction_id}) { print "ERROR: not all needed parameters were passed. This should never ". "happen! Please report this error.
\n"; return; } #### Find the corresponding information for this fraction_id $sql = qq~ SELECT fraction_tag,data_location,SB.search_batch_id, search_batch_subdir FROM $TBPR_FRACTION F INNER JOIN $TBPR_SEARCH_BATCH SB ON ( F.experiment_id = SB.experiment_id ) WHERE fraction_id IN ($parameters{fraction_id}) ~; my @fractions = $sbeams->selectSeveralColumns($sql); unless (@fractions) { print "ERROR: Unable to find any fractions for fraction_id". " = '$parameters{fraction_id}'. This really should never ". "happen! Please report the problem.
\n"; return; } #### Provide links to the plots foreach my $fraction_ref ( @fractions ) { $key = $fraction_ref->[0]; $value = $fraction_ref->[1]; my $search_batch_id = $fraction_ref->[2]; my $search_batch_subdir = $fraction_ref->[3]; #printf("%22s = %s
\n",$key,$value); print "

Fraction: $key

\n"; my $filename = "$value/../$key.png"; unless ($filename =~ /^\//) { $filename = $RAW_DATA_DIR{Proteomics}."/$filename"; } #print("filename = $filename
\n"); if ( -e $filename ) { print "
\n"; } else { print "[PLOTS NOT AVAILABLE FOR THIS FRACTION]
\n"; } } } # end printEntryForm