Fix for new NCBI BLAST raw format without GI and some other stuffs

webblast.pl

@@ -631,7 +631,7 @@ sub PARSING {
 
         if ( $distant==1 ){
             my $version_d, my $database_d, my $poste_d;
-            undef $/; ($query, $length_query) = ( $intra_res[0] =~ /Query=\s+(\S+)\s+Length=\s*(\d+)/smo );
+            undef $/; ($query, $length_query) = ( $intra_res[0] =~ /Query=\s+(\S+).*?\s+Length=\s*(\d+)/smo );
             $/ = "\n";
             open (F3, '<', 'web_tempo.result') or die;
             while ($_=<F3>){
@@ -691,15 +691,24 @@ sub PARSING {
             }
             elsif ( $method =~/^geneid$/i ){
                 if ( $database !~ /pdb/i && $database !~ /swiss/i && $locale =~ /1|2/){
-                    while ( $intra_res=~ />.*?(gb|prf|emb|sp|pir|tpe|ref|prf|dbj|ddbj|pdb)[\|]+([A-Za-z0-9_\.]+?)(\s|\|(.{1}))/sg ){
-                        my $databank = $1;
-                        my $last     = $4;
-                        my $refseq   = $2;
-                        if ( $databank eq 'pdb' ){
-                            $refseq .= $last;
+                    if ( $intra_res=~ />.*?[A-Za-z0-9_\.]+?\s+/ ){
+                        while ( $intra_res=~ />.*?([A-Za-z0-9_\.]+?)\s+/sg ){
+                            my $refseq   = $1;
+                            $refseq =~ s/\.\d+$//;
+                            push (@result_not_sort, "$query\t$refseq\t$identity\t$recouvrement\t$bits\t$evalue\tncbi");
+                        }
+                    }
+                    elsif ( $intra_res=~ />.*?(gb|prf|emb|sp|pir|tpe|ref|prf|dbj|ddbj|pdb)[\|]+([A-Za-z0-9_\.]+?)(\s|\|(.{1}))/ ){
+                        while ( $intra_res=~ />.*?(gb|prf|emb|sp|pir|tpe|ref|prf|dbj|ddbj|pdb)[\|]+([A-Za-z0-9_\.]+?)(\s|\|(.{1}))/sg ){
+                            my $databank = $1;
+                            my $last     = $4;
+                            my $refseq   = $2;
+                            if ( $databank eq 'pdb' ){
+                                $refseq .= $last;
+                            }
+                            $refseq =~ s/\.\d+$//;
+                            push (@result_not_sort, "$query\t$refseq\t$identity\t$recouvrement\t$bits\t$evalue\t$databank");
                         }
-                        $refseq =~ s/\.\d+$//;
-                        push (@result_not_sort, "$query\t$refseq\t$identity\t$recouvrement\t$bits\t$evalue\t$databank");
                     }
                 }
                 elsif ( $database=~ /pdb|pdbaa/i && ($locale==1 || $locale==2) ){
@@ -758,14 +767,23 @@ sub MULTI_EQUIVALENT {
     my($query, $identity, $recouvrement, $bits, $evalue, $intra_res) = @_;
 
     my @result=();
-    while ( $intra_res=~ />.*?(gb|prf|emb|sp|pir|tpe|ref|prf|dbj|ddbj|pdb)[\|]+([A-Za-z0-9_\.]+?)(\s|\|(.{1}))/g ){
-        my $databank = $1;
-        my $last     = $4;
-        my $refseq   = $2;
-
-        if ( $databank eq 'pdb' ){ $refseq .= $last; }
-        $refseq =~ s/\.\d+$//;
-        push (@result, "$query\t$refseq\t$identity\t$recouvrement\t$bits\t$evalue\t$databank");
+    if ( $intra_res=~ />.*?[A-Za-z0-9_\.]+?\s+/ ){
+        while ( $intra_res=~ />.*?([A-Za-z0-9_\.]+?)\s+/sg ){
+            my $refseq   = $1;
+            $refseq =~ s/\.\d+$//;
+            push (@result, "$query\t$refseq\t$identity\t$recouvrement\t$bits\t$evalue\tncbi");
+        }
+    }
+    elsif ( $intra_res=~ />.*?(gb|prf|emb|sp|pir|tpe|ref|prf|dbj|ddbj|pdb)[\|]+([A-Za-z0-9_\.]+?)(\s|\|(.{1}))/ ){
+        while ( $intra_res=~ />.*?(gb|prf|emb|sp|pir|tpe|ref|prf|dbj|ddbj|pdb)[\|]+([A-Za-z0-9_\.]+?)(\s|\|(.{1}))/g ){
+            my $databank = $1;
+            my $last     = $4;
+            my $refseq   = $2;
+
+            if ( $databank eq 'pdb' ){ $refseq .= $last; }
+            $refseq =~ s/\.\d+$//;
+            push (@result, "$query\t$refseq\t$identity\t$recouvrement\t$bits\t$evalue\t$databank");
+        }
     }
     return (@result);
 }