[Bio] / Sprout / SearchHelper.pm Repository:
ViewVC logotype

Diff of /Sprout/SearchHelper.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.30, Thu Apr 19 00:05:51 2007 UTC revision 1.33, Tue Jun 19 21:28:21 2007 UTC
# Line 19  Line 19 
19      use FeatureQuery;      use FeatureQuery;
20      use URI::Escape;      use URI::Escape;
21      use PageBuilder;      use PageBuilder;
22        use POSIX;
23    
24  =head1 Search Helper Base Class  =head1 Search Helper Base Class
25    
# Line 791  Line 792 
792      # Write the column headers and close the file.      # Write the column headers and close the file.
793      Tracer::PutLine($handle1, \@colNames);      Tracer::PutLine($handle1, \@colNames);
794      close $handle1;      close $handle1;
795        Trace("Column headers are: " . join("; ", @colNames) . ".") if T(3);
796      # Now open the sort pipe and save the file handle. Note how we append the      # Now open the sort pipe and save the file handle. Note how we append the
797      # sorted data to the column header row already in place. The output will      # sorted data to the column header row already in place. The output will
798      # contain a sort key followed by the real columns. The sort key is      # contain a sort key followed by the real columns. The sort key is
# Line 824  Line 826 
826      my ($self, $key, @colValues) = @_;      my ($self, $key, @colValues) = @_;
827      # Write them to the cache file.      # Write them to the cache file.
828      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);
829        Trace("Column data is " . join("; ", $key, @colValues) . ".") if T(4);
830  }  }
831    
832  =head3 CloseSession  =head3 CloseSession
# Line 873  Line 876 
876    
877  =head3 OrganismData  =head3 OrganismData
878    
879  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>  C<< my ($orgName, $group, $domain) = $shelp->Organism($genomeID); >>
880    
881  Return the name and status of the organism corresponding to the specified genome ID.  Return the name and status of the organism corresponding to the specified genome ID.
882  For performance reasons, this information is cached in a special hash table, so we  For performance reasons, this information is cached in a special hash table, so we
# Line 887  Line 890 
890    
891  =item RETURN  =item RETURN
892    
893  Returns a list of two items. The first item in the list is the organism name,  Returns a list of three items. The first item in the list is the organism name,
894  and the second is the name of the NMPDR group, or an empty string if the  and the second is the name of the NMPDR group, or an empty string if the
895  organism is not in an NMPDR group.  organism is not in an NMPDR group. The third item is the organism's domain.
896    
897  =back  =back
898    
# Line 899  Line 902 
902      # Get the parameters.      # Get the parameters.
903      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
904      # Declare the return variables.      # Declare the return variables.
905      my ($orgName, $group);      my ($orgName, $group, $domain);
906      # Check the cache.      # Check the cache.
907      my $cache = $self->{orgs};      my $cache = $self->{orgs};
908      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
909          ($orgName, $group) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
910      } else {      } else {
911          # Here we have to use the database.          # Here we have to use the database.
912          my $sprout = $self->DB();          my $sprout = $self->DB();
913          my ($genus, $species, $strain, $group) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $group, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,
914                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
915                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
916                                                       'Genome(primary-group)']);                                                                   'Genome(primary-group)',
917                                                                     'Genome(taxonomy)']);
918          # Format and cache the name and display group.          # Format and cache the name and display group.
919          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          ($orgName, $group, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
920                                                              $strain);                                                                $strain, $taxonomy);
921      }      }
922      # Return the result.      # Return the result.
923      return ($orgName, $group);      return ($orgName, $group, $domain);
924  }  }
925    
926  =head3 Organism  =head3 Organism
# Line 944  Line 948 
948      # Get the parameters.      # Get the parameters.
949      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
950      # Get the organism data.      # Get the organism data.
951      my ($retVal, $group) = $self->OrganismData($genomeID);      my ($retVal) = $self->OrganismData($genomeID);
952      # Return the result.      # Return the result.
953      return $retVal;      return $retVal;
954  }  }
# Line 1024  Line 1028 
1028    
1029  =head3 ComputeFASTA  =head3 ComputeFASTA
1030    
1031  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth); >>
1032    
1033  Parse a sequence input and convert it into a FASTA string of the desired type.  Parse a sequence input and convert it into a FASTA string of the desired type with
1034    the desired flanking width.
1035    
1036  =over 4  =over 4
1037    
# Line 1042  Line 1047 
1047  if the input does not begin with a greater-than sign (FASTA label line), a default label  if the input does not begin with a greater-than sign (FASTA label line), a default label
1048  line will be provided.  line will be provided.
1049    
1050    =item flankingWidth
1051    
1052    If the DNA FASTA of a feature is desired, the number of base pairs to either side of the
1053    feature that should be included. Currently we can't do this for Proteins because the
1054    protein translation of a feature doesn't always match the DNA and is taken directly
1055    from the database.
1056    
1057  =item RETURN  =item RETURN
1058    
1059  Returns a string in FASTA format representing the content of the desired sequence with  Returns a string in FASTA format representing the content of the desired sequence with
# Line 1054  Line 1066 
1066    
1067  sub ComputeFASTA {  sub ComputeFASTA {
1068      # Get the parameters.      # Get the parameters.
1069      my ($self, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence, $flankingWidth) = @_;
1070      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
1071      my $retVal;      my $retVal;
1072      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 1086  Line 1098 
1098                  $fastaLabel = $fid;                  $fastaLabel = $fid;
1099              }              }
1100              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
1101              if ($desiredType eq 'prot') {              if ($desiredType =~ /prot/) {
1102                  # We want protein, so get the translation.                  # We want protein, so get the translation.
1103                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
1104                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
1105              } else {              } else {
1106                  # We want DNA, so get the DNA sequence. This is a two-step process.                  # We want DNA, so get the DNA sequence. This is a two-step process. First, we get the
1107                    # locations.
1108                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
1109                    if ($flankingWidth > 0) {
1110                        # Here we need to add flanking data. Convert the locations to a list
1111                        # of location objects.
1112                        my @locObjects = map { BasicLocation->new($_) } @locList;
1113                        # Initialize the return variable. We will put the DNA in here segment by segment.
1114                        $fastaData = "";
1115                        # Now we widen each location by the flanking width and stash the results. This
1116                        # requires getting the contig length for each contig so we don't fall off the end.
1117                        for my $locObject (@locObjects) {
1118                            Trace("Current location is " . $locObject->String . ".") if T(4);
1119                            # Remember the current start and length.
1120                            my ($start, $len) = ($locObject->Left, $locObject->Length);
1121                            # Get the contig length.
1122                            my $contigLen = $sprout->ContigLength($locObject->Contig);
1123                            # Widen the location and get its DNA.
1124                            $locObject->Widen($flankingWidth, $contigLen);
1125                            my $fastaSegment = $sprout->DNASeq([$locObject->String()]);
1126                            # Now we need to do some case changing. The main DNA is upper case and
1127                            # the flanking DNA is lower case.
1128                            my $leftFlank = $start - $locObject->Left;
1129                            my $rightFlank = $leftFlank + $len;
1130                            Trace("Wide location is " . $locObject->String . ". Flanks are $leftFlank and $rightFlank. Contig len is $contigLen.") if T(4);
1131                            my $fancyFastaSegment = lc(substr($fastaSegment, 0, $leftFlank)) .
1132                                                    uc(substr($fastaSegment, $leftFlank, $rightFlank - $leftFlank)) .
1133                                                    lc(substr($fastaSegment, $rightFlank));
1134                            $fastaData .= $fancyFastaSegment;
1135                        }
1136                    } else {
1137                        # Here we have just the raw sequence.
1138                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
1139                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  }
1140                    Trace((length $fastaData) . " characters returned for DNA of $fastaLabel.") if T(3);
1141              }              }
1142          }          }
1143      } else {      } else {
# Line 1124  Line 1167 
1167      Trace("FASTA data sequence: $fastaData") if T(4);      Trace("FASTA data sequence: $fastaData") if T(4);
1168      # Only proceed if no error was detected.      # Only proceed if no error was detected.
1169      if ($okFlag) {      if ($okFlag) {
1170            if ($desiredType =~ /pattern/i) {
1171                # We're doing a scan, so only the data is passed in.
1172                $retVal = $fastaData;
1173            } else {
1174          # We need to format the sequence into 60-byte chunks. We use the infamous          # We need to format the sequence into 60-byte chunks. We use the infamous
1175          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
1176          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
# Line 1132  Line 1179 
1179          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
1180          $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
1181      }      }
1182        }
1183      # Return the result.      # Return the result.
1184      return $retVal;      return $retVal;
1185  }  }
# Line 1345  Line 1393 
1393      # Get the form name.      # Get the form name.
1394      my $formName = $self->FormName();      my $formName = $self->FormName();
1395      # Check to see if we already have a genome list in memory.      # Check to see if we already have a genome list in memory.
     my $genomes = $self->{genomeList};  
1396      my $groupHash;      my $groupHash;
1397        my @groups;
1398        my $nmpdrGroupCount;
1399        my $genomes = $self->{genomeList};
1400      if (defined $genomes) {      if (defined $genomes) {
1401          # We have a list ready to use.          # We have a list ready to use.
1402          $groupHash = $genomes;          $groupHash = $genomes;
1403            @groups = @{$self->{groupList}};
1404            $nmpdrGroupCount = $self->{groupCount};
1405      } else {      } else {
1406          # Get a list of all the genomes in group order. In fact, we only need them ordered          # Get a list of all the genomes in group order. In fact, we only need them ordered
1407          # by name (genus,species,strain), but putting primary-group in front enables us to          # by name (genus,species,strain), but putting primary-group in front enables us to
# Line 1358  Line 1410 
1410                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
1411                                           [], ['Genome(primary-group)', 'Genome(id)',                                           [], ['Genome(primary-group)', 'Genome(id)',
1412                                                'Genome(genus)', 'Genome(species)',                                                'Genome(genus)', 'Genome(species)',
1413                                                'Genome(unique-characterization)']);                                                'Genome(unique-characterization)',
1414                                                  'Genome(taxonomy)']);
1415          # Create a hash to organize the genomes by group. Each group will contain a list of          # Create a hash to organize the genomes by group. Each group will contain a list of
1416          # 2-tuples, the first element being the genome ID and the second being the genome          # 2-tuples, the first element being the genome ID and the second being the genome
1417          # name.          # name.
1418          my %gHash = ();          my %gHash = ();
1419          for my $genome (@genomeList) {          for my $genome (@genomeList) {
1420              # Get the genome data.              # Get the genome data.
1421              my ($group, $genomeID, $genus, $species, $strain) = @{$genome};              my ($group, $genomeID, $genus, $species, $strain, $taxonomy) = @{$genome};
1422              # Compute and cache its name and display group.              # Compute and cache its name and display group.
1423              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,              my ($name, $displayGroup, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1424                                                                  $strain);                                                                           $strain, $taxonomy);
1425              # Push the genome into the group's list. Note that we use the real group              # Push the genome into the group's list. Note that we use the real group
1426              # name here, not the display group name.              # name here, not the display group name.
1427              push @{$gHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name, $domain];
1428          }          }
1429            # We are almost ready to unroll the menu out of the group hash. The final step is to separate
1430            # the supporting genomes by domain. First, we sort the NMPDR groups.
1431            @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %gHash;
1432            # Remember the number of NMPDR groups.
1433            $nmpdrGroupCount = scalar @groups;
1434            # Loop through the supporting genomes, classifying them by domain. We'll also keep a list
1435            # of the domains found.
1436            my @otherGenomes = @{$gHash{$FIG_Config::otherGroup}};
1437            my @domains = ();
1438            for my $genomeData (@otherGenomes) {
1439                my ($genomeID, $name, $domain) = @{$genomeData};
1440                if (exists $gHash{$domain}) {
1441                    push @{$gHash{$domain}}, $genomeData;
1442                } else {
1443                    $gHash{$domain} = [$genomeData];
1444                    push @domains, $domain;
1445                }
1446            }
1447            # Add the domain groups at the end of the main group list. The main group list will now
1448            # contain all the categories we need to display the genomes.
1449            push @groups, sort @domains;
1450            # Delete the supporting group.
1451            delete $gHash{$FIG_Config::otherGroup};
1452          # Save the genome list for future use.          # Save the genome list for future use.
1453          $self->{genomeList} = \%gHash;          $self->{genomeList} = \%gHash;
1454            $self->{groupList} = \@groups;
1455            $self->{groupCount} = $nmpdrGroupCount;
1456          $groupHash = \%gHash;          $groupHash = \%gHash;
1457      }      }
     # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting  
     # the supporting-genome group last.  
     my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};  
     push @groups, $FIG_Config::otherGroup;  
1458      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal
1459      # with the possibility of undefined values in the incoming list.      # with the possibility of undefined values in the incoming list.
1460      my %selectedHash = ();      my %selectedHash = ();
# Line 1417  Line 1491 
1491          # Get the genomes in the group.          # Get the genomes in the group.
1492          for my $genome (@{$groupHash->{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1493              # Count this organism if it's NMPDR.              # Count this organism if it's NMPDR.
1494              if ($group ne $FIG_Config::otherGroup) {              if ($nmpdrGroupCount > 0) {
1495                  $nmpdrCount++;                  $nmpdrCount++;
1496              }              }
1497              # Get the organism ID and name.              # Get the organism ID, name, and domain.
1498              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name, $domain) = @{$genome};
1499              # See if it's selected.              # See if it's selected.
1500              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1501              # Generate the option tag.              # Generate the option tag.
1502              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION class=\"$domain\" value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1503              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1504          }          }
1505          # Close the option group.          # Close the option group.
1506          push @lines, "  </OPTGROUP>";          push @lines, "  </OPTGROUP>";
1507            # Record this group in the nmpdrGroup count. When that gets to 0, we've finished the NMPDR
1508            # groups.
1509            $nmpdrGroupCount--;
1510      }      }
1511      # Close the SELECT tag.      # Close the SELECT tag.
1512      push @lines, "</SELECT>";      push @lines, "</SELECT>";
# Line 2338  Line 2415 
2415      return $retVal;      return $retVal;
2416  }  }
2417    
2418    
2419    =head3 PrintLine
2420    
2421    C<< $shelp->PrintLine($message); >>
2422    
2423    Print a line of CGI output. This is used during the operation of the B<Find> method while
2424    searching, so the user sees progress in real-time.
2425    
2426    =over 4
2427    
2428    =item message
2429    
2430    HTML text to display.
2431    
2432    =back
2433    
2434    =cut
2435    
2436    sub PrintLine {
2437        # Get the parameters.
2438        my ($self, $message) = @_;
2439        # Send them to the output.
2440        print "$message\n";
2441    }
2442    
2443  =head2 Feature Column Methods  =head2 Feature Column Methods
2444    
2445  The methods in this section manage feature column data. If you want to provide the  The methods in this section manage feature column data. If you want to provide the
# Line 2428  Line 2530 
2530          $retVal = "Annotation Page";          $retVal = "Annotation Page";
2531      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
2532          $retVal = "Subsystems";          $retVal = "Subsystems";
2533        } elsif ($colName eq 'pdb') {
2534            $retVal = "Best PDB Match";
2535      }      }
2536      # Return the result.      # Return the result.
2537      return $retVal;      return $retVal;
# Line 2556  Line 2660 
2660      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
2661          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2662          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
2663        } elsif ($colName eq 'pdb') {
2664            $retVal = "%%pdb=$fid";
2665      }      }
2666      # Return the result.      # Return the result.
2667      return $retVal;      return $retVal;
# Line 2647  Line 2753 
2753                                        "Feature($keywordName)");                                        "Feature($keywordName)");
2754          # String them into a list.          # String them into a list.
2755          $retVal = join(", ", @values);          $retVal = join(", ", @values);
2756        } elsif ($type eq 'pdb') {
2757            # Here the caller wants the best PDB match to this feature. The text
2758            # is the feature ID. We will display the PDB with a link to the
2759            # PDB page along with the match score. If there are docking results we
2760            # will display a link to the docking result search.
2761            my $fid = $text;
2762            # Ask for the best PDB.
2763            my ($bestPDB) = $sprout->GetAll(['IsProteinForFeature', 'PDB'],
2764                                            "IsProteinForFeature(from-link) = ? ORDER BY IsProteinForFeature(score) LIMIT 1",
2765                                            [$fid], ['PDB(id)', 'PDB(docking-count)', 'IsProteinForFeature(score)']);
2766            # Only proceed if there is a PDB.
2767            if ($bestPDB) {
2768                my ($pdbID, $dockingCount, $score) = @{$bestPDB};
2769                # Convert the PDB ID to a hyperlink.
2770                my $pdbLink = SHDrugSearch::PDBLink($cgi, $pdbID);
2771                # Append the score.
2772                $retVal = "$pdbLink ($score)";
2773                # If there are docking results, append a docking results link.
2774                if ($dockingCount > 0) {
2775                    my $dockString = "$dockingCount docking results";
2776                    my $dockLink = $cgi->a({ href =>  $cgi->url() . "?Class=DrugSearch;PDB=$pdbID;NoForm=1",
2777                                             alt =>   "View computed docking results for $pdbID",
2778                                             title => "View computed docking results for $pdbID",
2779                                             target => "_blank"},
2780                                           $dockString);
2781                }
2782            }
2783        } elsif ($type eq 'role') {
2784            # Here the caller wants a functional role assignment. The key is the feature ID.
2785            $retVal = $sprout->FunctionOf($text);
2786        } elsif ($type eq 'loc') {
2787            # This is a tough one. We need to find the nearest feature in the appropriate direction
2788            # on the contig, and then output its id, functional role, and link button.
2789            if ($text =~ /^(.)\/(.+)/) {
2790                my ($direction, $locString) = ($1, $2);
2791                Trace("Location request of type $direction for $locString.") if T(3);
2792                # Convert the location string into a location object.
2793                my $loc = BasicLocation->new($locString);
2794                # Get the contig ID.
2795                my $contigID = $loc->Contig;
2796                # Compute the contig length.
2797                my $contigLen = $sprout->ContigLength($contigID);
2798                # Widen by the area to search in both directions.
2799                $loc->Widen(5000);
2800                # Now, if we're doing a before (-) search, we set the end point to the area's mid point.
2801                # If we're doing an after (+) search, we set the begin point to the area's mid point.
2802                my $mid = ($loc->Left + $loc->Right) / 2;
2803                # Compute the search direction.
2804                my $searchDir = ($direction eq $loc->Dir ? 1 : -1);
2805                # Adjust the midpoint so that it is different in the before direction from what it would
2806                # be in the after direction.
2807                if ($mid != int($mid)) {
2808                    # Here we need to round. The thing here is we want to round in a way that separates
2809                    # the after-search choice from the before-search choice.
2810                    if ($direction eq $loc->Dir) {
2811                        $mid = ceil($mid);
2812                    } else {
2813                        $mid = floor($mid);
2814                    }
2815                } elsif ($direction eq '+') {
2816                    # Here the midpoint is on a nucleotide and we are doing the after search. We bump the
2817                    # midpoint toward the end point.
2818                    $mid += $loc->NumDirection;
2819                }
2820                # Now put the midpoint on the proper end of the region.
2821                if ($direction eq '+') {
2822                    $loc->SetBegin($mid);
2823                } else {
2824                    $loc->SetEnd($mid);
2825                }
2826                Trace("Search region is " . $loc->String . ".") if T(3);
2827                # Find all the genes in the region.
2828                my ($fidList, $beg, $end) = $sprout->GenesInRegion($loc->Contig, $loc->Left, $loc->Right);
2829                Trace(scalar(@{$fidList}) . " features found.") if T(3);
2830                # Look for the best match.
2831                my $distance = 5000;
2832                my $chosenFid = undef;
2833                for my $fid (@{$fidList}) {
2834                    # Get the feature's location.
2835                    my ($locString) = $sprout->FeatureLocation($fid);
2836                    my $locObject = BasicLocation->new($locString);
2837                    # Check its begin point to see if we should keep it.
2838                    my $newDistance = ($mid - $locObject->Begin) * $searchDir;
2839                    Trace("Distance from $mid to $locString is $newDistance.") if T(4);
2840                    if ($newDistance > 0 && $newDistance < $distance) {
2841                        $distance = $newDistance;
2842                        $chosenFid = $fid;
2843                    }
2844                }
2845                # Only proceed if we found something.
2846                if (defined $chosenFid) {
2847                    my $role = $sprout->FunctionOf($chosenFid);
2848                    my $linkButton = SearchHelper::FakeButton('NMPDR', "protein.cgi", undef,
2849                                                               prot => $chosenFid, SPROUT => 1,
2850                                                               new_framework => 0, user => '');
2851                    $retVal = "$chosenFid&nbsp;$linkButton&nbsp;$role";
2852                }
2853            } else {
2854                Confess("Invalid location request %%loc=$text.");
2855            }
2856      }      }
2857      # Return the result.      # Return the result.
2858      return $retVal;      return $retVal;
# Line 2654  Line 2860 
2860    
2861  =head3 SaveOrganismData  =head3 SaveOrganismData
2862    
2863  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); >>
2864    
2865  Format the name of an organism and the display version of its group name. The incoming  Format the name of an organism and the display version of its group name. The incoming
2866  data should be the relevant fields from the B<Genome> record in the database. The  data should be the relevant fields from the B<Genome> record in the database. The
# Line 2684  Line 2890 
2890    
2891  Strain of the species represented by the genome.  Strain of the species represented by the genome.
2892    
2893    =item taxonomy
2894    
2895    Taxonomy of the species represented by the genome.
2896    
2897  =item RETURN  =item RETURN
2898    
2899  Returns a two-element list. The first element is the formatted genome name. The second  Returns a three-element list. The first element is the formatted genome name. The second
2900  element is the display name of the genome's group.  element is the display name of the genome's group. The third is the genome's domain.
2901    
2902  =back  =back
2903    
# Line 2695  Line 2905 
2905    
2906  sub SaveOrganismData {  sub SaveOrganismData {
2907      # Get the parameters.      # Get the parameters.
2908      my ($self, $group, $genomeID, $genus, $species, $strain) = @_;      my ($self, $group, $genomeID, $genus, $species, $strain, $taxonomy) = @_;
2909      # Declare the return values.      # Declare the return values.
2910      my ($name, $displayGroup);      my ($name, $displayGroup);
2911      # If the organism does not exist, format an unknown name and a blank group.      # If the organism does not exist, format an unknown name and a blank group.
# Line 2712  Line 2922 
2922          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2923          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2924      }      }
2925        # Compute the domain from the taxonomy.
2926        my ($domain) = split /\s*;\s*/, $taxonomy, 2;
2927      # Cache the group and organism data.      # Cache the group and organism data.
2928      my $cache = $self->{orgs};      my $cache = $self->{orgs};
2929      $cache->{$genomeID} = [$name, $displayGroup];      $cache->{$genomeID} = [$name, $displayGroup, $domain];
2930      # Return the result.      # Return the result.
2931      return ($name, $displayGroup);      return ($name, $displayGroup, $domain);
2932  }  }
2933    
2934  =head3 ValidateKeywords  =head3 ValidateKeywords
# Line 2814  Line 3026 
3026      # Compute the target-frame HTML.      # Compute the target-frame HTML.
3027      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $targetHtml = ($target ? " target=\"$target\"" : "");
3028      # Assemble the result.      # Assemble the result.
3029      return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";      return "<a href=\"$targetUrl\" $targetHtml><span class=\"button2 button\">$caption</span></a>";
3030  }  }
3031    
3032  =head3 Formlet  =head3 Formlet
# Line 2976  Line 3188 
3188      return $retVal;      return $retVal;
3189  }  }
3190    
3191  =head3 PrintLine  =head3 SearchTitle
3192    
3193  C<< $shelp->PrintLine($message); >>  C<< my $titleHtml = $shelp->SearchTitle(); >>
3194    
3195  Print a line of CGI output. This is used during the operation of the B<Find> method while  Return the display title for this search. The display title appears above the search results.
3196  searching, so the user sees progress in real-time.  If no result is returned, no title will be displayed. The result should be an html string
3197    that can be legally put inside a block tag such as C<h3> or C<p>.
3198    
3199    =cut
3200    
3201    sub SearchTitle {
3202        # Get the parameters.
3203        my ($self) = @_;
3204        # Declare the return variable.
3205        my $retVal;
3206        # Return it.
3207        return $retVal;
3208    }
3209    
3210    =head3 DownloadFormatAvailable
3211    
3212    C<< my $okFlag = $shelp->DownloadFormatAvailable($format); >>
3213    
3214    This method returns TRUE if a specified download format is legal for this type of search
3215    and FALSE otherwise. For any feature-based search, there is no need to override this
3216    method.
3217    
3218  =over 4  =over 4
3219    
3220  =item message  =item format
3221    
3222  HTML text to display.  Download format type code.
3223    
3224    =item RETURN
3225    
3226    Returns TRUE if the download format is legal for this search and FALSE otherwise.
3227    
3228  =back  =back
3229    
3230  =cut  =cut
3231    
3232  sub PrintLine {  sub DownloadFormatAvailable {
3233      # Get the parameters.      # Get the parameters.
3234      my ($self, $message) = @_;      my ($self, $format) = @_;
3235      # Send them to the output.      # Declare the return variable.
3236      print "$message\n";      my $retVal = 1;
3237        # Return the result.
3238        return $retVal;
3239    }
3240    
3241    =head3 ColumnTitle
3242    
3243    C<< my $title = $shelp->ColumnTitle($colName); >>
3244    
3245    Return the column heading title to be used for the specified column name. The
3246    default implementation is to simply call L</FeatureColumnTitle>.
3247    
3248    =over 4
3249    
3250    =item colName
3251    
3252    Name of the desired column.
3253    
3254    =item RETURN
3255    
3256    Returns the title to be used as the column header for the named column.
3257    
3258    =back
3259    
3260    =cut
3261    
3262    sub ColumnTitle {
3263        my ($self, $colName) = @_;
3264        return $self->FeatureColumnTitle($colName);
3265  }  }
3266    
3267    

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.33

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3