#!/usr/local/bin/perl ############################################################################### # Program : GetImage # Author : Eric Deutsch # $Id$ # # Description : This CGI program sends the requested image # based on various parameters # # 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 $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::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; ############################################################################### # Set program name and usage banner for command like use ############################################################################### $PROG_NAME = $FindBin::Script; $USAGE = <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( permitted_work_groups_ref=>['Proteomics_user','Proteomics_admin', 'Proteomics_readonly'], #connect_read_only=>1, #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); #### Decide what action to take based on information so far if ($parameters{action} eq "???") { # Some action } else { #$sbeamsMOD->display_page_header(); handle_request(ref_parameters=>\%parameters); #$sbeamsMOD->display_page_footer(); } } # end main ############################################################################### # Handle Request ############################################################################### 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); #### verify that needed parameters were passed unless ($parameters{fraction_id} && $parameters{search_batch_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 FROM $TBPR_FRACTION F INNER JOIN $TBPR_SEARCH_BATCH SB ON ( F.experiment_id = SB.experiment_id ) WHERE fraction_id = '$parameters{fraction_id}' AND SB.search_batch_id = '$parameters{search_batch_id}' ~; my %fractions = $sbeams->selectTwoColumnHash($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; } #### Send the data print "Content-type: image/png\n\n"; while ( ($key,$value) = each %fractions ) { my $filename = "$value/../$key.png"; $filename = "$value/$key.ms.png" if ($parameters{image_type} eq 'MSrun'); $filename = "$value/$key.msvflip.png" if ($parameters{image_type} eq 'MSrun_vflip'); unless ($filename =~ /^\//) { $filename = $RAW_DATA_DIR{Proteomics}."/$filename"; } my $buffer; open(DATA, $filename) || die("Couldn't open $filename: ".$!); while (read(DATA, $buffer, 1024)) { print $buffer; } last; } } # end handle_request