[Bio] / FigKernelPackages / FIG.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/FIG.pm

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

revision 1.532, Sat Oct 14 17:29:32 2006 UTC revision 1.533, Thu Nov 2 17:12:19 2006 UTC
# Line 4090  Line 4090 
4090      return "";      return "";
4091  }  }
4092    
4093    sub orgid_of_orgname {
4094      my($self,$genome_name) = @_;
4095      my $relational_db_response;
4096      my $rdbH = $self->db_handle;
4097    
4098      my $genome_nameQ = quotemeta $genome_name;
4099    
4100      if (($relational_db_response =
4101           $rdbH->SQL("SELECT genome FROM genome WHERE gname='$genome_nameQ'")) &&
4102          (@$relational_db_response >= 1)) {
4103        return $relational_db_response->[0]->[0];
4104      }
4105      return "";
4106    }
4107    
4108    sub orgname_of_orgid {
4109      my($self,$genome) = @_;
4110      my $relational_db_response;
4111      my $rdbH = $self->db_handle;
4112    
4113      if (($relational_db_response =
4114           $rdbH->SQL("SELECT gname FROM genome WHERE genome='$genome'")) &&
4115          (@$relational_db_response >= 1)) {
4116        return $relational_db_response->[0]->[0];
4117      }
4118      return "";
4119    }
4120    
4121  =head3 genus_species_domain  =head3 genus_species_domain
4122    
4123  C<< my ($gs, $domain) = $fig->genus_species_domain($genome_id); >>  C<< my ($gs, $domain) = $fig->genus_species_domain($genome_id); >>
# Line 4264  Line 4292 
4292      return $genome_name;      return $genome_name;
4293  }  }
4294    
4295    sub wikipedia_link {
4296      my ($self, $organism_name) = @_;
4297    
4298      my $link = undef;
4299      my @organism_tokens = split(/\s/, $organism_name);
4300      my $wikipedia_url = "http://en.wikipedia.org/wiki/";
4301      my $curr_link = $wikipedia_url . $organism_tokens[0];
4302      if (scalar(@organism_tokens) > 1) {
4303        $curr_link .= "_" . $organism_tokens[1];
4304      }
4305    
4306      my $ua = new LWP::UserAgent;
4307    
4308      my $res = $ua->get($curr_link);
4309      if (not $res->is_success) {
4310        print STDERR "Could not access Wikipedia\n";
4311        return undef;
4312      }
4313      my $page = $res->content;
4314    
4315      if ($page =~ /Wikipedia does not have an article with this exact name/) {
4316        $curr_link = $wikipedia_url . $organism_tokens[0];
4317        $res = $ua->get($curr_link);
4318        $page = $res->content;
4319        if ($page =~ /Wikipedia does not have an article with this exact name/) {
4320          $link = undef;
4321        } else {
4322          $link = $curr_link;
4323        }
4324      } else {
4325        $link = $curr_link;
4326      }
4327    
4328      return $link;
4329    }
4330    
4331  =head3 ncbi_contig_description  =head3 ncbi_contig_description
4332    
4333  C<<my $name = ncbi_contig_description($contig_id)>>  C<<my $name = ncbi_contig_description($contig_id)>>
# Line 5575  Line 5639 
5639      return \@features;      return \@features;
5640  }  }
5641    
5642    # does the same as the above, except using the advantage of a join statement
5643    # and including minloc and maxloc as well as the function, annotator and quality
5644    sub all_features_detailed_fast {
5645      my($self,$genome, $min, $max, $contig) = @_;
5646    
5647      my $minmax = "";
5648      if (defined($min) && defined($max)) {
5649        $minmax = "AND ((minloc < $min AND maxloc > $min) OR (minloc < $max AND maxloc > $max) OR (minloc > $min AND maxloc < $max)) ";
5650      }
5651    
5652      my $contig_line = "";
5653      if (defined($contig)) {
5654        $contig_line = "AND features.contig = '" . $contig . "' ";
5655      }
5656    
5657      my $rdbH = $self->db_handle;
5658      my $relational_db_response = $rdbH->SQL("SELECT id, location, aliases, type, minloc, maxloc, assigned_function, made_by, quality FROM (SELECT id, location, aliases, type, minloc, maxloc FROM features LEFT OUTER JOIN deleted_fids ON features.id = deleted_fids.fid WHERE features.genome = '" . $genome . "' " . $contig_line . $minmax . "AND fid IS NULL) AS t1 LEFT OUTER JOIN assigned_functions on t1.id = assigned_functions.prot");
5659    
5660      return $relational_db_response || ();
5661    
5662    # SELECT id, location, aliases, type, minloc, maxloc, assigned_function, made_by, quality FROM (SELECT id, location, aliases, type, minloc, maxloc FROM features LEFT OUTER JOIN deleted_fids ON features.id = deleted_fids.fid WHERE features.genome = '83333.1' AND ((minloc < 1 AND maxloc > 1) OR (minloc < 4639221 AND maxloc > 4639221) OR (minloc > 1 AND maxloc < 4639221)) AND fid IS NULL) AS t1 LEFT OUTER JOIN assigned_functions on t1.id = assigned_functions.prot;
5663    }
5664    
5665    sub essentiality_data {
5666      my($self,$genome,$experiment, $value) = @_;
5667    
5668      my $rdbH = $self->db_handle;
5669    
5670      my $defined_val = "";
5671      if (defined($value)) {
5672        $defined_val = " AND val='" . $value . "'";
5673      }
5674    
5675      my $statement = "SELECT prot, aliases, assigned_function, val, minloc FROM (SELECT CONCAT('fig|', genome, '.', ftype, '.', id) AS pid, val FROM attribute WHERE genome='" . $genome . "' AND tag='" . $experiment . "'" . $defined_val . ") AS t1 LEFT OUTER JOIN assigned_functions on t1.pid = assigned_functions.prot LEFT OUTER JOIN features ON t1.pid = features.id ORDER BY minloc";
5676    
5677      my $relational_db_response = $rdbH->SQL($statement);
5678    
5679      my $return;
5680      foreach my $row (@$relational_db_response) {
5681          my $retval = $rdbH->SQL("SELECT DISTINCTROW subsystem from subsystem_index WHERE protein='" . $row->[0] . "'");
5682          my $subsystems;
5683          foreach my $subsystem (@$retval) {
5684            push(@$subsystems, $subsystem->[0]);
5685          }
5686          push(@$row, $subsystems || []);
5687          push(@$return, $row);
5688      }
5689    
5690      return $return || ();
5691    }
5692    
5693    sub contig_lengths {
5694      my ($self, $genome) = @_;
5695    
5696      my $contig_lengths;
5697    
5698      my $rdbH = $self->db_handle;
5699    
5700      my $relational_db_response = $rdbH->SQL("SELECT contig, len FROM contig_lengths WHERE genome=$genome");
5701    
5702      foreach my $contig (@$relational_db_response) {
5703        $contig_lengths->{$contig->[0]} = $contig->[1];
5704      }
5705    
5706      return $contig_lengths;
5707    }
5708    
5709  =head3 all_features  =head3 all_features
5710    
# Line 10732  Line 10862 
10862          my @aliases = $self->feature_aliases($fid);          my @aliases = $self->feature_aliases($fid);
10863          my $a_string =join(" ",@aliases);          my $a_string =join(" ",@aliases);
10864          #my $a_string = "test";          #my $a_string = "test";
10865          push (@results, [$fid, $org, $a_string,"[attribute $tag] $value"] );          push (@results, [$fid, $org, $a_string,"[attribute $tag] $value", $genome] );
10866          #the prior way - modified to accomodate consistent format of downloaded results          #the prior way - modified to accomodate consistent format of downloaded results
10867          #push (@results, [$fid, $org, "[attribute $tag] $value",""] );          #push (@results, [$fid, $org, "[attribute $tag] $value",""] );
10868      }      }
# Line 11984  Line 12114 
12114      return ();      return ();
12115  }  }
12116    
12117    sub roles_for_prot {
12118        my($self, $prot) = @_;
12119    
12120        $prot = quotemeta $prot;
12121    
12122        my $rdbH = $self->db_handle;
12123        my $relational_db_response = $rdbH->SQL("SELECT role FROM roles WHERE prot='$prot' ");
12124        if (@$relational_db_response > 0)
12125        {
12126            return map { $_->[0] } @$relational_db_response;
12127        }
12128        return ();
12129    }
12130    
12131    sub prots_for_role {
12132        my($self, $role) = @_;
12133    
12134        $role = quotemeta $role;
12135    
12136        my $rdbH = $self->db_handle;
12137        my $relational_db_response = $rdbH->SQL("SELECT prot FROM roles WHERE role='$role' AND prot LIKE 'fig|%' AND NOT prot LIKE 'fig|9999999%' ");
12138        if (@$relational_db_response > 0)
12139        {
12140            return map { $_->[0] } @$relational_db_response;
12141        }
12142        return ();
12143    }
12144    
12145  =head3 ec_to_maps  =head3 ec_to_maps
12146    
12147  C<< my @maps = $fig->ec_to_maps($ec); >>  C<< my @maps = $fig->ec_to_maps($ec); >>
# Line 12173  Line 12331 
12331      return sort keys(%subs);      return sort keys(%subs);
12332  }  }
12333    
12334    sub protein_subsystem_to_roles {
12335        my($self,$prot, $subsystem) = @_;
12336    
12337        my($relational_db_response);
12338        my $rdbH = $self->db_handle;
12339        my $subsystemQ = quotemeta $subsystem;
12340        my $protQ = quotemeta $prot;
12341        my $query = "SELECT role FROM subsystem_index WHERE protein=\'$protQ\' AND subsystem=\'$subsystemQ\'";
12342        return (($relational_db_response = $rdbH->SQL($query)) && (@$relational_db_response >= 1)) ?
12343            $relational_db_response->[0] : ();
12344    }
12345    
12346  sub role_to_subsystems {  sub role_to_subsystems {
12347      my($self,$role) = @_;      my($self,$role) = @_;
12348    
# Line 13167  Line 13337 
13337      return ($tree,&tips_of_tree($tree));      return ($tree,&tips_of_tree($tree));
13338  }  }
13339    
13340    sub get_taxonomy_tree {
13341        my($self) = @_;
13342    
13343        my $relational_db_response;
13344        my $rdbH = $self->db_handle;
13345    
13346        if (($relational_db_response = $rdbH->SQL("SELECT genome, taxonomy FROM genome ")) && (@$relational_db_response > 0)) {
13347    
13348          my $tree = {};
13349          foreach my $element (@$relational_db_response) {
13350            if ($element->[0] !~ /^99999/) {
13351              my @tax_list = map { '{"' . $_ . '"}' } split("; ", $element->[1]);
13352              for (my $i=0; $i<scalar(@tax_list); $i++) {
13353                my @x = @tax_list;
13354                splice(@x, $i + 1);
13355                my $a = '$tree->' . join('->', @x);
13356                eval 'unless (exists(' . $a . ')) { ' . $a . '= {}; }';
13357              }
13358            }
13359          }
13360    
13361          return $tree;
13362        } else {
13363          return undef;
13364        }
13365    }
13366    
13367  sub limit_labels {  sub limit_labels {
13368      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
13369      my($tree,$min_for_label) = @_;      my($tree,$min_for_label) = @_;
# Line 13951  Line 14148 
14148    
14149  =head3 subsystem_info  =head3 subsystem_info
14150    
14151    Returns the number of diagrams of the passed subsystem.
14152    
14153    =cut
14154    
14155    sub subsystem_num_diagrams {
14156      my($self,$ssa) = @_;
14157    
14158      my $diag_dir = "$FIG_Config::data/Subsystems/$ssa/diagrams";
14159      if (opendir(DIR, $diag_dir))
14160        {
14161          my @diagrams = grep { /^d/ && -d "$diag_dir/$_" } readdir(DIR);
14162          closedir DIR;
14163          return scalar(@diagrams);
14164        }
14165      else
14166        {
14167          return 0;
14168        }
14169    }
14170    
14171    =head3 subsystem_info
14172    
14173  usage: ($version, $curator, $pedigree, $roles) = $fig->subsystem_info($subsystem_name)  usage: ($version, $curator, $pedigree, $roles) = $fig->subsystem_info($subsystem_name)
14174    
14175  Return information about the given subsystem.  Return information about the given subsystem.
# Line 15265  Line 15484 
15484  }  }
15485    
15486    
15487    =head2 Search Database
15488    
15489    Searches the database for objects that match the query string in some way.
15490    
15491    Returns a list of results if the query is ambiguous or an unique identifier
15492    otherwise.
15493    
15494    =cut
15495    
15496    sub search_database {
15497      # get parameters
15498      my ($self, $query, $options) = @_;
15499    
15500      # get cgi
15501      my $cgi = new CGI;
15502    
15503      # turn query string into lower case
15504      $query = lc($query);
15505      my $ss_query = $query;
15506      $ss_query =~ s/ /_/g;
15507      my @tokenized = split(/ /, $query);
15508    
15509      # check for options, otherwise set default values
15510      if (defined($options)) {
15511    
15512      }
15513    
15514      # get database handle
15515      my $dbh = $self->db_handle();
15516    
15517      # check exact organism name and id
15518      my $result = $dbh->SQL("SELECT genome FROM genome WHERE LOWER(gname)='$query' OR genome='$query'");
15519      if (scalar(@$result) > 0) { return { type => 'organism', result => $result->[0]->[0] }; }
15520    
15521      # check exact subsystem
15522      $result = $dbh->SQL("SELECT subsystem FROM subsystem_index WHERE LOWER(subsystem)='$ss_query'");
15523      if (scalar(@$result) > 0) { return { type => 'subsystem', result => $result->[0]->[0] }; }
15524    
15525      # check fig-id
15526      $result = $dbh->SQL("SELECT id FROM features WHERE id='$query'");
15527      if (scalar(@$result) > 0) { return { type => 'feature', result => $result->[0]->[0] }; }
15528    
15529      # check unique alias
15530      $result = $dbh->SQL("SELECT id FROM ext_alias WHERE alias='$query'");
15531      if (scalar(@$result) > 0) { return { type => 'feature', result => $result->[0]->[0] }; }
15532    
15533      # exact search failed, sum up all the fuzzy searches
15534      my $return_value;
15535    
15536      # check functional role
15537      $result = $dbh->SQL("SELECT DISTINCTROW role, subsystem FROM subsystem_index WHERE LOWER(role) LIKE '%" . $query . "%'");
15538      if (scalar(@$result) > 0) { push(@$return_value, { type => 'functional_role', result => $result }); }
15539    
15540      # check organism name and domain
15541      my $result = $dbh->SQL("SELECT DISTINCTROW genome, gname, maindomain FROM genome WHERE LOWER(gname) LIKE '%" . $query . "%' OR LOWER(maindomain)='$query'");
15542      if (scalar(@$result) > 0) { push(@$return_value, { type => 'organism', result => $result }); }
15543    
15544      # check subsystem
15545      $result = $dbh->SQL("SELECT DISTINCTROW subsystem FROM subsystem_index WHERE LOWER(subsystem) LIKE '%" . $ss_query . "%'");
15546      if (scalar(@$result) > 0) { push(@$return_value, { type => 'subsystem', result => $result }); }
15547    
15548      # check for extended search
15549      unless ($cgi->param('quick_search')) {
15550        my @tokens;
15551        foreach (@tokenized) {
15552          push(@tokens, "LOWER(role) LIKE '%" . $_ . "%'");
15553        }
15554        my $comp = join(' AND ', @tokens);
15555        $result = $dbh->SQL("SELECT DISTINCTROW prot, role, org FROM roles WHERE prot LIKE 'fig%' AND " . $comp . " LIMIT 100");
15556        if (scalar(@$result) > 0) { push(@$return_value, { type => 'proteins', result => $result }); }
15557      }
15558    
15559      return $return_value;
15560    }
15561    
15562    sub flat {
15563      my ($in) = @_;
15564    
15565      my $out;
15566    
15567      foreach (@$in) { push(@$out, $_->[0]); }
15568    
15569      return $out;
15570    }
15571    
15572  ###########  ###########
15573  #  #
15574  #  #

Legend:
Removed from v.1.532  
changed lines
  Added in v.1.533

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3