From: martinahansen <martinahansen@74ccb610-7750-0410-82ae-013aeee3265d>
Date: Thu, 18 Mar 2010 09:59:00 +0000 (+0000)
Subject: error handling and seq guess fix
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1acff5c01f3ef8a5850943535677bac784d4a44e;p=biopieces.git

error handling and seq guess fix

git-svn-id: http://biopieces.googlecode.com/svn/trunk@931 74ccb610-7750-0410-82ae-013aeee3265d
---

diff --git a/code_perl/Maasha/Align.pm b/code_perl/Maasha/Align.pm
index 622846d..a01ec4b 100644
--- a/code_perl/Maasha/Align.pm
+++ b/code_perl/Maasha/Align.pm
@@ -272,7 +272,7 @@ sub align_pins
 
     $type ||= Maasha::Seq::seq_guess_type( $entry1->[ SEQ ] );
 
-    $blosum = blosum_read() if $type =~ /protein/;
+    $blosum = blosum_read() if $type eq "PROTEIN";
 
     for ( $i = 0; $i < length $entry1->[ SEQ ]; $i++ )
     {
@@ -480,9 +480,9 @@ sub align_tile
 
         $type = Maasha::Seq::seq_guess_type( $seq1 );
 
-        if ( $type =~ /rna/i ) {
+        if ( $type eq "RNA" ) {
             $seq2 = Maasha::Seq::rna_revcomp( $seq1 );
-        } elsif ( $type =~ /dna/i ) {
+        } elsif ( $type eq "DNA" ) {
             $seq2 = Maasha::Seq::dna_revcomp( $seq1 );
         } else {
             Maasha::Common::error( qq(Bad sequence type->$type) );
diff --git a/code_perl/Maasha/BGB/Track.pm b/code_perl/Maasha/BGB/Track.pm
index 5322636..2c08223 100644
--- a/code_perl/Maasha/BGB/Track.pm
+++ b/code_perl/Maasha/BGB/Track.pm
@@ -857,7 +857,9 @@ sub list_assembly_dir
 
     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 
-    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
+    if ( $user and $clade and $genome ) {
+        @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
+    }
 
     @assemblies = grep { $_ !~ /\/\.\.?$/ } @dirs;
 
@@ -908,7 +910,9 @@ sub list_contig_dir
 
     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 
-    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
+    if ( $user and $clade and $genome and $assembly ) {
+        @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
+    }
 
     @contigs = grep { $_ !~ /\/\.\.?$/ } @dirs;
 
diff --git a/code_perl/Maasha/Biopieces.pm b/code_perl/Maasha/Biopieces.pm
index 1865cca..70e332e 100644
--- a/code_perl/Maasha/Biopieces.pm
+++ b/code_perl/Maasha/Biopieces.pm
@@ -56,6 +56,9 @@ $SIG{ 'INT' }     = \&sig_handler;
 $SIG{ 'TERM' }    = \&sig_handler;
 
 
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
 sub status_set
 {
     my ( $time_stamp, $script, $user, $pid, $file, $fh );
diff --git a/code_perl/Maasha/Match.pm b/code_perl/Maasha/Match.pm
index 1e971ba..6ddd413 100644
--- a/code_perl/Maasha/Match.pm
+++ b/code_perl/Maasha/Match.pm
@@ -76,7 +76,7 @@ sub match_mummer
     push @args, "-F";
     push @args, "-l $options->{ 'word_size' }";
     push @args, "-maxmatch";
-    push @args, "-n" if not Maasha::Seq::seq_guess_type( $entries1->[ 0 ]->[ 1 ] ) eq "protein";
+    push @args, "-n" if not Maasha::Seq::seq_guess_type( $entries1->[ 0 ]->[ 1 ] ) eq "PROTEIN";
     push @args, "-b" if $options->{ "direction" } =~ /^b/;
     push @args, "-r" if $options->{ "direction" } =~ /^r/;
 
diff --git a/code_perl/Maasha/Plot.pm b/code_perl/Maasha/Plot.pm
index 4ac7159..06a401f 100644
--- a/code_perl/Maasha/Plot.pm
+++ b/code_perl/Maasha/Plot.pm
@@ -771,7 +771,7 @@ sub seq_logo
 
     $type = Maasha::Seq::seq_guess_type( $entries->[ 0 ]->[ 1 ] );
 
-    if ( $type =~ /^p/i ) {
+    if ( $type eq "PROTEIN" ) {
         $bit_max = 4;
     } else {
         $bit_max = 2;
diff --git a/code_perl/Maasha/Seq.pm b/code_perl/Maasha/Seq.pm
index bc07bce..4d6c799 100644
--- a/code_perl/Maasha/Seq.pm
+++ b/code_perl/Maasha/Seq.pm
@@ -931,8 +931,8 @@ sub seq_alph
         PROTEIN  => [ qw(F L S Y C W P H Q R I M T N K V A D E G) ],
     );
 
-    if ( exists $alph_hash{ $type } ) {
-        $alph = $alph_hash{ $type };
+    if ( exists $alph_hash{ uc $type } ) {
+        $alph = $alph_hash{ uc $type };
     } else {
         die qq(ERROR: Unknown alphabet type: "$type"\n);
     }
diff --git a/code_perl/Maasha/XHTML.pm b/code_perl/Maasha/XHTML.pm
index 7fd5f69..0992c7c 100755
--- a/code_perl/Maasha/XHTML.pm
+++ b/code_perl/Maasha/XHTML.pm
@@ -1,6 +1,6 @@
 package Maasha::XHTML;
 
-# Copyright (C) 2005 Martin A. Hansen.
+# Copyright (C) 2005-2010 Martin A. Hansen.
 
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License
@@ -80,6 +80,48 @@ require Exporter;
 @ISA = qw( Exporter );
 
 
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SIGNAL HANDLERS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+use sigtrap qw( die normal-signals stack-trace any error-signals );
+
+my $WARNINGS = 0;
+
+$SIG{ '__DIE__' }  = \&sig_die;
+$SIG{ '__WARN__' } = \&sig_warn;
+
+
+sub sig_die
+{
+    my ( $sig,   # signal from the %SIG
+       ) = @_;
+
+    my ( @html );
+
+    push @html, &cgi_header;
+    push @html, p( txt => "ERROR: $sig" );
+
+    $WARNINGS++;
+
+    print "$_" for @html;
+}
+
+
+sub sig_warn
+{
+    my ( $sig,   # signal from the %SIG
+       ) = @_;
+
+    my ( @html );
+
+    push @html, &cgi_header if $WARNINGS == 0;
+    push @html, p( txt => "WARNING: $sig" );
+
+    $WARNINGS++;
+
+    print "$_" for @html;
+}
+
+
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEADERS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
@@ -96,7 +138,7 @@ sub html_header
 
     my ( @html );
 
-    push @html, &cgi_header                            if $args{ "cgi_header" };
+    push @html, &cgi_header                            if $args{ "cgi_header" } and $WARNINGS == 0;
     push @html, &doc_type;
     push @html, &head_beg;
     push @html, &title( $args{ "title" } )             if $args{ "title" };
diff --git a/www/index.cgi b/www/index.cgi
index 9734938..9d68897 100755
--- a/www/index.cgi
+++ b/www/index.cgi
@@ -67,7 +67,6 @@ push @html, Maasha::XHTML::html_end;
 
 print "$_\n" foreach @html;
 
-
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<