[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.28, Tue Apr 10 06:05:40 2007 UTC revision 1.29, Sat Apr 14 21:41:25 2007 UTC
# Line 742  Line 742 
742      }      }
743      # Get the feature ID.      # Get the feature ID.
744      my $fid = $fd->FID();      my $fid = $fd->FID();
745      # Loop through the column headers, producing the desired data.      # Loop through the column headers, producing the desired data. The first column
746      my @output = ();      # is the feature ID. The feature ID does not show up in the output: its purpose
747        # is to help the various output formatters.
748        my @output = ($fid);
749      for my $colName (@{$self->{cols}}) {      for my $colName (@{$self->{cols}}) {
750          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);
751      }      }
# Line 1052  Line 1054 
1054      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
1055      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
1056      Trace("FASTA desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
1057      # Check for a feature specification.      # Check for a feature specification. The smoking gun for that is a vertical bar.
1058      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
1059          # Here we have a feature ID in $1. We'll need the Sprout object to process          # Here we have a feature ID in $1. We'll need the Sprout object to process
1060          # it.          # it.
# Line 1067  Line 1069 
1069              $self->SetMessage("No gene found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
1070              $okFlag = 0;              $okFlag = 0;
1071          } else {          } else {
1072              # Set the FASTA label.              # Set the FASTA label. The ID is the first favored alias.
1073              my $fastaLabel = $fid;              my $favored = $self->Q()->param('FavoredAlias') || 'fig';
1074                my $favorLen = length $favored;
1075                ($fastaLabel) = grep { substr($_, 0, $favorLen) eq $favored } $sprout->FeatureAliases($fid);
1076                if (! $fastaLabel) {
1077                    # In an emergency, fall back to the original ID.
1078                    $fastaLabel = $fid;
1079                }
1080              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
1081              if ($desiredType eq 'prot') {              if ($desiredType eq 'prot') {
1082                  # We want protein, so get the translation.                  # We want protein, so get the translation.
# Line 1518  Line 1526 
1526  =item rows  =item rows
1527    
1528  Reference to a list of table rows. Each table row must be in HTML form with all  Reference to a list of table rows. Each table row must be in HTML form with all
1529  the TR and TD tags set up. The first TD or TH tag in each row will be modified to  the TR and TD tags set up. The first TD or TH tag in the first non-colspanned row
1530  set the width. Everything else will be left as is.  will be modified to set the width. Everything else will be left as is.
1531    
1532  =item RETURN  =item RETURN
1533    
# Line 1534  Line 1542 
1542      my ($self, $rows) = @_;      my ($self, $rows) = @_;
1543      # Get the CGI object.      # Get the CGI object.
1544      my $cgi = $self->Q();      my $cgi = $self->Q();
1545      # Fix the widths on the first column. Note that we eschew the use of the "g"      # The first column of the first row must have its width fixed.
1546        # This flag will be set to FALSE when that happens.
1547        my $needWidth = 1;
1548      # modifier becase we only want to change the first tag. Also, if a width      # modifier becase we only want to change the first tag. Also, if a width
1549      # is already specified on the first column bad things will happen.      # is already specified on the first column bad things will happen.
1550      for my $row (@{$rows}) {      for my $row (@{$rows}) {
1551          $row =~ s/(<td|th)/$1 width="150"/i;          # See if this row needs a width.
1552            if ($needWidth && $row =~ /<(td|th) ([^>]+)>/i) {
1553                # Here we have a first cell and its tag parameters are in $2.
1554                my $elements = $2;
1555                if ($elements !~ /colspan/i) {
1556                    Trace("No colspan tag found in element \'$elements\'.") if T(3);
1557                    # Here there's no colspan, so we plug in the width. We
1558                    # eschew the "g" modifier on the substitution because we
1559                    # only want to update the first cell.
1560                    $row =~ s/(<(td|th))/$1 width="150"/i;
1561                    # Denote we don't need this any more.
1562                    $needWidth = 0;
1563                }
1564            }
1565      }      }
1566      # Create the table.      # Create the table.
1567      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = $cgi->table({border => 2, cellspacing => 2,
# Line 2485  Line 2508 
2508      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
2509          # In this case, the user wants a list of external aliases for the feature.          # In this case, the user wants a list of external aliases for the feature.
2510          # These are very expensive, so we compute them when the row is displayed.          # These are very expensive, so we compute them when the row is displayed.
2511          $retVal = "%%alias=$fid";          # To do the computation, we need to know the favored alias type and the
2512            # feature ID.
2513            my $favored = $cgi->param("FavoredAlias") || "fig";
2514            $retVal = "%%alias=$fid,$favored";
2515      } elsif ($colName eq 'fid') {      } elsif ($colName eq 'fid') {
2516          # Here we have the raw feature ID. We hyperlink it to the protein page.          # Here we have the raw feature ID. We hyperlink it to the protein page.
2517          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
# Line 2564  Line 2590 
2590      # Separate the text into a type and data.      # Separate the text into a type and data.
2591      if ($type eq 'alias') {      if ($type eq 'alias') {
2592          # Here the caller wants external alias links for a feature. The text          # Here the caller wants external alias links for a feature. The text
2593          # is the feature ID.          # parameter for computing the alias is the feature ID followed by
2594          my $fid = $text;          # the favored alias type.
2595          # The complicated part is we have to hyperlink them. First, get the          my ($fid, $favored) = split /\s*,\s*/, $text;
2596          # aliases.          # The complicated part is we have to hyperlink them and handle the
2597            # favorites. First, get the aliases.
2598          Trace("Generating aliases for feature $fid.") if T(4);          Trace("Generating aliases for feature $fid.") if T(4);
2599          my @aliases = $sprout->FeatureAliases($fid);          my @aliases = sort $sprout->FeatureAliases($fid);
2600          # Only proceed if we found some.          # Only proceed if we found some.
2601          if (@aliases) {          if (@aliases) {
2602              # Join the aliases into a comma-delimited list.              # Split the aliases into favored and unfavored.
2603              my $aliasList = join(", ", @aliases);              my @favored = ();
2604                my @unfavored = ();
2605                for my $alias (@aliases) {
2606                    # Use substr instead of pattern match because $favored is specified by the user
2607                    # and we don't want him to put funny meta-characters in there.
2608                    if (substr($alias, 0, length($favored)) eq $favored) {
2609                        push @favored, $alias;
2610                    } else {
2611                        push @unfavored, $alias;
2612                    }
2613                }
2614                # Rejoin the aliases into a comma-delimited list, with the favored ones first.
2615                my $aliasList = join(", ", @favored, @unfavored);
2616              # Ask the HTML processor to hyperlink them.              # Ask the HTML processor to hyperlink them.
2617              $retVal = HTML::set_prot_links($cgi, $aliasList);              $retVal = HTML::set_prot_links($cgi, $aliasList);
2618          }          }

Legend:
Removed from v.1.28  
changed lines
  Added in v.1.29

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3