#!/usr/local/bin/perl ############################################################################### # Program : ManageTable.cgi # Author : Eric Deutsch # $Id$ # # Description : This CGI program that allows users to # manage the contents of a table. # This means viewing, inserting, updating, # and deleting records. # # 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 $dbh $current_contact_id $current_username $PROG_NAME $USAGE %OPTIONS $QUIET $VERBOSE $DEBUG $DATABASE $current_work_group_id $current_work_group_name $current_project_id $current_project_name $TABLE_NAME $PROGRAM_FILE_NAME $CATEGORY $DB_TABLE_NAME $PK_COLUMN_NAME @MENU_OPTIONS); use DBI; #use CGI; use CGI::Carp qw(fatalsToBrowser croak); use SBEAMS::Connection qw($q $log); use SBEAMS::Connection::Settings; use SBEAMS::Connection::Tables; use SBEAMS::Connection::TableInfo; use SBEAMS::BioLink::Tables; #$q = new CGI; $sbeams = new SBEAMS::Connection; use SBEAMS::Microarray; use SBEAMS::Microarray::Settings; use SBEAMS::Microarray::Tables; use SBEAMS::Microarray::TableInfo; $sbeamsMOD = new SBEAMS::Microarray; $sbeamsMOD->setSBEAMS($sbeams); $sbeams->setSBEAMS_SUBDIR($SBEAMS_SUBDIR); require 'ManageTable.pllib'; ############################################################################### # Set program name and usage banner for command like use ############################################################################### $PROG_NAME = $FindBin::Script; $USAGE = <InterfaceEntry with pointer to the subroutine to execute if # the authentication succeeds. ############################################################################### 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=>['Proteomics_user','Proteomics_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); #### Process generic "state" parameters before we start $sbeams->processStandardParameters(parameters_ref=>\%parameters); $TABLE_NAME = $parameters{'TABLE_NAME'} || croak "TABLE_NAME not specified."; croak "This TABLE_NAME=$TABLE_NAME cannot be managed by this program." unless ($sbeamsMOD->returnTableInfo($TABLE_NAME, "ManageTableAllowed"))[0] eq "YES"; ($CATEGORY) = $sbeamsMOD->returnTableInfo($TABLE_NAME,"CATEGORY"); ($PROGRAM_FILE_NAME) = $sbeamsMOD->returnTableInfo($TABLE_NAME, "PROGRAM_FILE_NAME"); ($DB_TABLE_NAME) = $sbeamsMOD->returnTableInfo($TABLE_NAME,"DB_TABLE_NAME"); ($PK_COLUMN_NAME) = $sbeamsMOD->returnTableInfo($TABLE_NAME, "PK_COLUMN_NAME"); @MENU_OPTIONS = $sbeamsMOD->returnTableInfo($TABLE_NAME,"MENU_OPTIONS"); #### Decide what action to take based on information so far if ($parameters{"GetFile"} && $parameters{"$PK_COLUMN_NAME"}) { getFile(); return; } $sbeamsMOD->printPageHeader(); if ($parameters{action} eq 'VIEWRESULTSET') { printOptions(); } elsif ($parameters{action} eq 'REFRESH') { printEntryForm(); } elsif ($parameters{action} eq 'SAVE TEMPLATE') { saveTemplate(); } elsif ($parameters{action} eq 'SET FIELDS TO THIS TEMPLATE') { printEntryForm(); } elsif ($parameters{action} eq 'DELETE THIS TEMPLATE') { deleteTemplate( selected_template => $parameters{selected_template}, program_file_name => $PROGRAM_FILE_NAME, ); } elsif ($parameters{action}) { processEntryForm(); } elsif ($q->param('apply_action_hidden')) { printEntryForm(); } elsif ($q->param('ShowEntryForm')) { printEntryForm(); } elsif ($parameters{"$PK_COLUMN_NAME"}) { printEntryForm(); } else { printOptions(); } $sbeamsMOD->printPageFooter(); } # end main ############################################################################### # preFormHook # # This is a hook to do some processing before all the lines of data entry # form have been displayed based on the current table name. This might be # used to set some defaults or something. ############################################################################### sub preFormHook { my %args = @_; my $query_parameters_ref = $args{'parameters_ref'}; #### If table XXXX if ($TABLE_NAME eq "XXXX") { $query_parameters_ref->{YYYY} = 'XXXX' unless ($query_parameters_ref->{YYYY}); } #### Otherwise, no special processing, so just return undef return; } # end preFormHook ############################################################################### # postFormHook # # This is a hook to do some processing after all the lines of data entry # form have been displayed but before the table has been closed based on # the current table name. ############################################################################### sub postFormHook { my %args = @_; my $query_parameters_ref = $args{'parameters_ref'}; my %parameters = %{$query_parameters_ref}; #### If table XXXX if ($TABLE_NAME eq "XXXX") { return "An error of some sort $parameters{something} invalid"; } if ($TABLE_NAME eq "MA_labeling" && $parameters{array_request_sample_id} gt "") { my $sql_query = qq~ SELECT DISTINCT extinction_coeff_at_max,correction_260, Ebase,MWbase FROM $TBMA_DYE D LEFT JOIN $TBMA_LABELING_METHOD LM ON ( D.dye_id = LM.dye_id ) LEFT JOIN $TBMA_ARRAY_REQUEST_SAMPLE ARS ON ( LM.labeling_method_id = ARS.labeling_method_id ) WHERE array_request_sample_id IN ($parameters{array_request_sample_id}) ~; my @rows = $sbeams->selectSeveralColumns($sql_query); my ($Edye,$CFdye,$Ebase,$MWbase) = 0; if (@rows) { ($Edye,$CFdye,$Ebase,$MWbase) = @{$rows[0]}; } if (scalar @rows > 1) { print "WARNING:". ""; print " SAMPLES USING MORE THAN ONE TYPE OF ". "DYE SELECTED????
CALCULATION BELOW MAY BE WRONG!". "\n"; } my $A260 = $parameters{absorbance_260}*$parameters{dilution_factor}; my $Adye = $parameters{absorbance_lambda}*$parameters{dilution_factor}; my $volume = $parameters{volume}; my $Abase = $A260 - ($Adye * $CFdye); print "Edye:"; print " $Edye\n"; print " Extinction coefficient for dye\n"; print "CFdye:"; print " $CFdye\n"; print " Absorbance at 260 nm correction factor for dye\n"; print "Ebase:"; print " $Ebase\n"; print " Extinction coefficient for a base\n"; print "MWbase:"; print " $MWbase\n"; print " Molecular weight for a base in g/mol\n"; if ($Adye==0 || $Ebase==0 || $Edye==0) { print qq~ Insufficient data to calculate values. Please enter measurements above and press \n ~; return; } my $NucAcid = ($Abase * $MWbase) / $Ebase; my $basedye = ($Abase * $Edye) / ($Adye * $Ebase); my $TotNucAcid = $NucAcid * $volume; my $pmoldyeul = $Adye/($Edye*1e-6); my $totpmoldye = $pmoldyeul * $volume; print "Abase:"; print " ",sprintf("%10.4f",$Abase),"\n"; print " Absorbance at 260 after using CFdye\n"; print "[nucleic acid](ug/ul):"; print " ",sprintf("%10.6f",$NucAcid),"\n"; print "base:dye:"; print " ",sprintf("%10.1f",$basedye),"\n"; print "total nucleic acid (ug):"; print " ",sprintf("%10.2f",$TotNucAcid),"\n"; print " in units of micrograms (ug)\n"; print "pmol dye/ul:"; print " ",sprintf("%10.2f",$pmoldyeul),"\n"; print "total pmol dye:"; print " ",sprintf("%10.1f",$totpmoldye),"\n"; } if ($TABLE_NAME eq "MA_array_scan") { if ($parameters{stage_location} gt "") { if ( -d "$parameters{stage_location}/Images" ) { print "Status:"; print " Images/ subdirectory verified\n"; } else { print "WARNING:"; print " Images/ subdirectory not ". "found\n"; } } } if ($TABLE_NAME eq "MA_array_quantitation") { if ($parameters{stage_location} gt "") { if ( -e "$parameters{stage_location}" ) { print "Status:"; print " Existence of data file verified\n"; } else { print "WARNING:"; print " Data file does not exist at ". "STAGE location\n"; } } } if ($TABLE_NAME eq "MA_array_layout") { if ($parameters{source_filename} gt "") { if ( -e "$parameters{source_filename}" ) { print "Status:"; print " Existence of data file verified\n"; } else { print "WARNING:"; print " Data file does not exist at ". "specified location\n"; } } } #### Otherwise, no special processing, so just return undef return; } # end postFormHook ############################################################################### # preUpdateDataCheck # # For certain tables, there are additional checks that should be made before # an INSERT or UPDATE is performed. ############################################################################### sub preUpdateDataCheck { my %args = @_; my $query_parameters_ref = $args{'parameters_ref'}; my %parameters = %{$query_parameters_ref}; if ( $parameters{project_id} ) { # We can short-circuit the permissions check my $errstr = checkProjectPermission( param_ref => $query_parameters_ref, tname => $TABLE_NAME, dbtname => $DB_TABLE_NAME ); return ( $errstr ) if $errstr; } elsif ( $TABLE_NAME eq "MA_array" ) { # Must have an project_id return "Error: project_id not defined" if !$parameters{project_id}; my $errstr = checkPermission( fkey => 'project_id', fval => $parameters{project_id}, pval => $parameters{array_id}, action => $parameters{action}, tname => $TABLE_NAME ); return ( $errstr ) if $errstr; } elsif ( $TABLE_NAME eq "MA_array_scan" ) { # Must have an array_id return "Error: array_id not defined" if !$parameters{array_id}; my $errstr = checkPermission( fkey => 'array_id', fval => $parameters{array_id}, pval => $parameters{array_scan_id}, action => $parameters{action}, tname => $TABLE_NAME ); return ( $errstr ) if $errstr; } elsif ( $TABLE_NAME eq "MA_labeling" ) { # Must have an array_id return "Error: array_id not defined" if !$parameters{array_request_sample_id}; my $errstr = checkPermission( fkey => 'array_request_sample_id', fval => $parameters{array_request_sample_id}, pval => $parameters{labeling_id}, action => $parameters{action}, tname => $TABLE_NAME ); return ( $errstr ) if $errstr; } elsif ( $TABLE_NAME eq "MA_hybridization" ) { # Must have an array_id return "Error: array_id not defined" if !$parameters{array_id}; my $errstr = checkPermission( fkey => 'array_id', fval => $parameters{array_id}, pval => $parameters{hybridization_id}, action => $parameters{action}, tname => $TABLE_NAME ); return ( $errstr ) if $errstr; } elsif ($TABLE_NAME eq "MA_array_quantitation") { # Must have an array_scan_id return "Error: array_id not defined" if !$parameters{array_scan_id}; my $errstr = checkPermission( fkey => 'array_scan_id', fval => $parameters{array_scan_id}, pval => $parameters{array_quantification_id}, action => $parameters{action}, tname => $TABLE_NAME ); return ( $errstr ) if $errstr; unless ( ($parameters{stage_location} gt "") && ( -e "$parameters{stage_location}" ) ) { return "The specified quantitation data file does not exist (looking ". "for file '$parameters{stage_location}')"; } } elsif ( $TABLE_NAME eq "MA_array_scan" ) { # Must have an array_id return "Error: array_id not defined" if !$parameters{array_id}; my $errstr = checkPermission( fkey => 'array_id', fval => $parameters{array_id}, pval => $parameters{array_scan_id}, action => $parameters{action}, tname => $TABLE_NAME ); return ( $errstr ) if $errstr; } elsif ($TABLE_NAME eq "MA_array_layout") { unless ( ($parameters{source_filename} gt "") && ( -e "$parameters{source_filename}" ) ) { return "The specified layout key file does not exist (looking for ". "file '$parameters{source_filename}')"; } } elsif ($TABLE_NAME eq "XXXX") {# If table XXXX return "An error of some sort $parameters{something} invalid"; } #### Otherwise, no special processing, so just return empty string return ''; } # end preUpdateDataCheck ############################################################################### # postUpdateOrInsertHook # # This is a hook to do some processing after the record has been updated # or inserted. ############################################################################### sub postUpdateOrInsertHook { my %args = @_; my $query_parameters_ref = $args{'parameters_ref'}; my %parameters = %{$query_parameters_ref}; my $pk_value = $args{'pk_value'}; #### If table XXXX if ($TABLE_NAME eq "XXXX") { return "An error of some sort $parameters{something} invalid"; } #### Otherwise, no special processing, so just return undef return; } # end postUpdateOrInsertHook