view release on metacpan or  search on metacpan

lib/Bio/Tools/Run/Ensembl.pm  view on Meta::CPAN

    #print ". ";
    
    my $gene_adaptor = $class->get_adaptor($species, 'Gene') || return;
    
    # get the first gene that matches our query, warn if more than one did
    my @genes = @{$gene_adaptor->fetch_all_by_external_name($gene_name)};
    my $gene = shift(@genes);
    
    # if not good enough, try again using orthologues
    if ($use_orth && (! $gene || @genes > 0)) {
        my @tests;
        if (ref($use_orth) && ref($use_orth) eq 'ARRAY') {
            @tests = @{$use_orth};
        }
        else {
            @tests = ($use_orth);
        }
        
        my $alias_species = Bio::EnsEMBL::Registry->get_alias($species);
        
        foreach my $test_species (@tests) {
            $test_species = $test_species->scientific_name if ref($test_species);
            $test_species eq $species and next;
            
            my $test_gene = $class->get_gene_by_name(-species => $test_species,
                                                     -name => $gene_name,
                                                     -strict => 1) || next;
            my $homologue_results_ref = $test_gene->get_all_homologous_Genes();
            
            # get the species and gene id of each homologue
            foreach my $result_ref (@{$homologue_results_ref}) {
                my ($homolog_gene, $homology, $homolog_species) = @{$result_ref};
                
                # get_alias returns lower case, underscored version of what we get here
                $homolog_species = lc($homolog_species);
                $homolog_species =~ s/ /_/g;
                $homolog_species eq $alias_species or next;
                
                $homology->description eq 'UBRH' or next;
                
                $gene = $homolog_gene;
                $ORTHS++;
                last;
            }
            
            $gene and last;
        }
    }
    
    # if not good enough, try again using swissprot
    if ($use_swiss && (! $gene || @genes > 0)) {
        my $swiss_id;
        
        #*** swiss look up should be farmed out to some dedicated class
        my $swiss_name = lc($gene_name);
        my $swiss_species = lc($species);
        $swiss_species =~ s/\s/+/g;
        my $url = "http://www.expasy.org/cgi-bin/get-entries?db=sp&db=tr&DE=&GNc=AND&GN=$swiss_name&OC=$swiss_species&view=&num=100";
        my $web_agent = Bio::WebAgent->new();
        $web_agent->url($url);
        my $rq = HTTP::Request->new(GET=>$url);
        my $reply = $web_agent->request($rq);
        if ($reply->is_error) {
            $class->throw($reply->as_string()."\nError getting for url $url!\n");
        }
        my $content = $reply->content;
        if ($content && $content !~ /No entries have been found/) {
            my @possibles = split("<tr><td><input type=checkbox name=ac value=", $content);
            shift(@possibles);
            
            my @good_ids;
            foreach my $poss (@possibles) {
                my ($id, $desc) = $poss =~ /^.+?<td>(.+?)<\/td>.+?<b>.+?<b>(.+?)<\/td>/;
                unless ($desc =~ /Fragment/) {
                    push(@good_ids, $id);
                }
            }
            
            if (@good_ids == 1) {
                $swiss_id = shift(@good_ids);
            }
        }
        
        if ($swiss_id) {
            @genes = @{$gene_adaptor->fetch_all_by_external_name($swiss_id)};
            $gene = shift(@genes);
            $SWISS++ if ($gene && @genes == 0);
        }
    }
    
    # if not good enough, try again with search for the gene name at ncbi
    if ($use_entrez && (! $gene || @genes > 0)) {
        my $esearch = Bio::DB::EUtilities->new(-eutil      => 'esearch',
                                               -db         => 'gene',
                                               -term       => $taxid ? "$gene_name ${taxid}[taxid]" : "$gene_name \"$species\"[Organism]",
                                               -usehistory => 'y',
                                               -verbose    => -1);
        my $esummary = Bio::DB::EUtilities->new(-eutil  => 'esummary',
                                                -history => $esearch->next_History);
        eval {$esummary->parse_data;};
        if (!$@) {
            my $ncbi_id;
            while (my $docsum = $esummary->next_DocSum) {
                my $item = $docsum->get_Item_by_name('Name');
                if (lc($item->get_content) eq lc($gene_name)) {
                    $ncbi_id = $docsum->get_id;
                    last;
                }
            }
            
            if ($ncbi_id) {
                @genes = @{$gene_adaptor->fetch_all_by_external_name($ncbi_id)};
                $gene = shift(@genes);
                $NCBI++ if ($gene && @genes == 0);
            }
        }
    }
    
    if (@genes > 0) {
        return if $strict;
        #$class->warn("Species '$species' had multiple matches to gene '$gene_name', using first gene '".$gene->display_id."'");