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

Diff of /FigKernelPackages/Observation.pm

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

revision 1.73, Tue Sep 9 14:38:50 2008 UTC revision 1.74, Thu Feb 5 18:44:35 2009 UTC
# Line 11  Line 11 
11  use WebConfig;  use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14    use LWP::Simple;
15  #use strict;  #use strict;
16  #use warnings;  #use warnings;
17  use HTML;  use HTML;
# Line 333  Line 334 
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
337          $domain_classes{'CDD'} = 1;          #$domain_classes{'CDD'} = 1;
338          $domain_classes{'PFAM'} = 1;          $domain_classes{'PFAM'} = 1;
339          get_identical_proteins($fid,\@matched_datasets,$fig);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
# Line 1298  Line 1299 
1299                                  -password => $WebConfig::DBPWD);                                  -password => $WebConfig::DBPWD);
1300    
1301      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1302      if($db eq "CDD"){  
1303          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1304          if(!scalar(@$cdd_objs)){          my $new_id;
1305              $name_title = "name";          if ($id =~ /_/){
1306              $name_value = "not available";              ($new_id) = ($id) =~ /(.*?)_/;
             $description_title = "description";  
             $description_value = "not available";  
1307          }          }
1308          else{          else{
1309              my $cdd_obj = $cdd_objs->[0];              $new_id = $id;
             $name_title = "name";  
             $name_value = $cdd_obj->term;  
             $description_title = "description";  
             $description_value = $cdd_obj->description;  
         }  
1310      }      }
1311      elsif($db =~ /PFAM/){  
         my ($new_id) = ($id) =~ /(.*?)_/;  
1312          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1313          if(!scalar(@$pfam_objs)){          if(!scalar(@$pfam_objs)){
1314              $name_title = "name";              $name_title = "name";
# Line 1371  Line 1364 
1364    
1365      my $link;      my $link;
1366      my $link_url;      my $link_url;
1367      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}  #    if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1368      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}      if($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1369      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1370    
1371      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1401  Line 1394 
1394      my $data = [];      my $data = [];
1395      my $count = 0;      my $count = 0;
1396      my $content;      my $content;
1397        my $seen = {};
1398    
1399      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1400          next if ($thing->type !~ /dom/);          next if ($thing->type !~ /dom/);
# Line 1416  Line 1410 
1410                                  -password => $WebConfig::DBPWD);                                  -password => $WebConfig::DBPWD);
1411    
1412          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1413          if($db eq "CDD"){  
1414              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );          my $new_id;
1415              if(!scalar(@$cdd_objs)){          if($db =~ /PFAM/){
1416                  $name_title = "name";              if ($id =~ /_/){
1417                  $name_value = "not available";                  ($new_id) = ($id) =~ /(.*?)_/;
                 $description_title = "description";  
                 $description_value = "not available";  
1418              }              }
1419              else{              else{
1420                  my $cdd_obj = $cdd_objs->[0];                  $new_id = $id;
                 $name_title = "name";  
                 $name_value = $cdd_obj->term;  
                 $description_title = "description";  
                 $description_value = $cdd_obj->description;  
             }  
1421          }          }
1422          elsif($db =~ /PFAM/){  
1423              my ($new_id) = ($id) =~ /(.*?)_/;              next if ($seen->{$new_id});
1424                $seen->{$new_id}=1;
1425    
1426              my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );              my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1427    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1428              if(!scalar(@$pfam_objs)){              if(!scalar(@$pfam_objs)){
1429                  $name_title = "name";                  $name_title = "name";
1430                  $name_value = "not available";                  $name_value = "not available";
# Line 1453  Line 1443 
1443          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1444    
1445          push(@$single_domain,$db);          push(@$single_domain,$db);
1446          push(@$single_domain,$thing->acc);          push(@$single_domain,$new_id);
1447          push(@$single_domain,$name_value);          push(@$single_domain,$name_value);
1448          push(@$single_domain,$location);          push(@$single_domain,$location);
1449          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
# Line 2598  Line 2588 
2588      my $figfams = new FFs($figfam_data);      my $figfams = new FFs($figfam_data);
2589    
2590      foreach my $id (@$ids){      foreach my $id (@$ids){
2591          my ($ff) =  $figfams->families_containing_peg($id);          my ($ff);
2592            if ($id =~ /\.peg\./){
2593                ($ff) =  $figfams->families_containing_peg($id);
2594            }
2595          if ($ff){          if ($ff){
2596              push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");              push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2597          }          }
# Line 2795  Line 2788 
2788              my $pretty_code = $code->[2];              my $pretty_code = $code->[2];
2789              if ($pretty_code =~ /;/) {              if ($pretty_code =~ /;/) {
2790                  my ($cd, $ss) = split(";", $code->[2]);                  my ($cd, $ss) = split(";", $code->[2]);
                 #print STDERR "$id: $cd, $ss\n";  
2791                  if ($cd =~ /ilit|dlit/){                  if ($cd =~ /ilit|dlit/){
2792                      my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;                      my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2793                      my $publink = &HTML::alias_url($pubmed_id,'PMID');                      my $publink = &HTML::alias_url($pubmed_id,'PMID');
# Line 2864  Line 2856 
2856                      my @parts = split("::",$code);                      my @parts = split("::",$code);
2857                      my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";                      my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2858    
2859                      # get the locations for the domain  #                   # get the locations for the domain
2860                      my @locs;  #                   my @locs;
2861                      foreach my $part (@{$attribute_location{$id}{$code}}){  #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2862                          my ($loc) = ($part) =~ /\;(.*)/;  #                       my ($loc) = ($part) =~ /\;(.*)/;
2863                          push (@locs,$loc);  #                       push (@locs,$loc);
2864                      }  #                   }
2865                      my %locsaw;  #                   my %locsaw;
2866                      foreach my $key (@locs) {$locsaw{$key}=1;}  #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2867                      @locs = keys %locsaw;  #                   @locs = keys %locsaw;
2868    #
2869                      my $locations = join (", ", @locs);  #                   my $locations = join (", ", @locs);
2870    #
2871                      if (defined ($description_codes{$parts[1]})){                      if (defined ($description_codes{$parts[1]})){
2872                          push(@pfam_codes, "$parts[1] ($locations)");                          push(@pfam_codes, "$parts[1]");
2873                      }                      }
2874                      else {                      else {
2875                          my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                          my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2876                          $description_codes{$parts[1]} = $description->[0]->{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2877                          push(@pfam_codes, "$pfam_link ($locations)");                          push(@pfam_codes, "$pfam_link");
2878                      }                      }
2879                  }                  }
2880    
# Line 2991  Line 2983 
2983      return $column;      return $column;
2984  }  }
2985    
2986    sub get_aclh_aliases {
2987        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2988        my $db_array;
2989    
2990        my $id_line = join (",", @$ids);
2991        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
2992    
2993    
2994    }
2995    
2996    sub get_id_aliases {
2997        my ($id, $fig) = @_;
2998        my $aliases = {};
2999    
3000        my $org = $fig->org_of($id);
3001        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3002        if ( my $form = &LWP::Simple::get($url) ) {
3003            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3004            foreach my $line (split /\n/, $block){
3005                my @values = split /\t/, $line;
3006                next if ($values[3] eq "Expert");
3007                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3008                    $aliases->{$values[4]} = $values[0];
3009                }
3010            }
3011        }
3012    
3013        return $aliases;
3014    }
3015    
3016  sub get_db_aliases {  sub get_db_aliases {
3017      my ($ids,$fig,$db,$cgi,$returnType) = @_;      my ($ids,$fig,$db,$cgi,$returnType) = @_;
   
3018      my $db_array;      my $db_array;
3019      my $all_aliases = $fig->feature_aliases_bulk($ids);      my $all_aliases = $fig->feature_aliases_bulk($ids);
3020      foreach my $id (@$ids){      foreach my $id (@$ids){
3021    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3022            my $id_org = $fig->org_of($id);
3023    
3024          foreach my $alias (@{$$all_aliases{$id}}){          foreach my $alias (@{$$all_aliases{$id}}){
3025    #       foreach my $alias (@all_aliases){
3026              my $id_db = &Observation::get_database($alias);              my $id_db = &Observation::get_database($alias);
3027              next if ( ($id_db ne $db) && ($db ne 'all') );              next if ( ($id_db ne $db) && ($db ne 'all') );
3028              next if ($aliases->{$id}->{$db});              next if ($aliases->{$id}->{$db});
3029                my $alias_org = $fig->org_of($alias);
3030    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3031                    #push(@funcs, [$id,$id_db,$tmp]);
3032              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3033    #           }
3034          }          }
3035          if (!defined( $aliases->{$id}->{$db})){          if (!defined( $aliases->{$id}->{$db})){
3036              $aliases->{$id}->{$db} = " ";              $aliases->{$id}->{$db} = " ";

Legend:
Removed from v.1.73  
changed lines
  Added in v.1.74

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3