lib/SGN/Controller/Organism.pm

   1 =head1 NAME
   2
   3 SGN::Controller::Organism - Catalyst controller for dealing with
   4 organism data
   5
   6 =cut
   7
   8 package SGN::Controller::Organism;
   9
  10 use Moose;
  11 use namespace::autoclean;
  12
  13 BEGIN { extends 'Catalyst::Controller' }
  14
  15 use Storable;
  16
  17 use Cache::File;
  18 use HTTP::Status;
  19 use JSON::Any; my $json = JSON::Any->new;
  20 use List::MoreUtils qw/ any /;
  21 use YAML::Any;
  22
  23 use CXGN::Chado::Organism;
  24 use CXGN::Login;
  25 use CXGN::Phylo::OrganismTree;
  26 use CXGN::Page::FormattingHelpers qw | tooltipped_text |;
  27 use CXGN::Tools::Text;
  28 use SGN::Image;
  29 use Data::Dumper;
  30
  31 with 'Catalyst::Component::ApplicationAttribute';
  32
  33 =head1 ACTIONS
  34
  35 =head2 view_all
  36
  37 Public Path: /organism/all/view
  38
  39 Display the sgn data overview page.
  40
  41 =cut
  42
  43 sub view_all :Path('/organism/all/view') :Args(0) {
  44     my ( $self, $c ) = @_;
  45
  46     while( my ( $set_name, $set_callback ) = each %{ $self->organism_sets } ) {
  47         next unless $set_name =~ /^web_visible_(.+)/;
  48         my $family_name = $1;
  49
  50         my $tree = $self->rendered_organism_tree_cache->thaw( $set_name );
  51         $tree->{set_name} = $set_name;
  52         $c->stash->{organism_trees}->{$family_name} = $tree;
  53
  54     }
  55
  56     # add image_uris to each of the organism tree records
  57     foreach my $v (values %{ $c->stash->{organism_trees} }) {
  58         $v->{image_uri} = $c->uri_for( $self->action_for('organism_tree_image'), [ $v->{set_name} ])->relative();
  59    }
  60
  61
  62     $c->stash({
  63         template => '/content/sgn_data.mas',
  64     });
  65 }
  66
  67
  68
  69
  70 # /organism/set/<set_name>
  71 sub get_organism_set :Chained('/') :PathPart('organism/set') :CaptureArgs(1) {
  72     my ( $self, $c, $set_name ) = @_;
  73
  74     $c->stash->{organism_set_name} = $set_name;
  75     $c->stash->{organism_set} = $self->organism_sets->{ $set_name }
  76         or $c->debug && $c->log->debug("no set found called '$set_name'");
  77 }
  78
  79 # /organism/tree/<set_name>
  80 sub get_organism_tree :Chained('/') :PathPart('organism/tree') :CaptureArgs(1) {
  81     my ( $self, $c, $set_name ) = @_;
  82
  83     $c->stash->{organism_set_name} = $set_name;
  84     # the Cache::Entry for the slot in the cache for this organism tree
  85     $c->stash->{organism_tree_cache_entry} = $self->rendered_organism_tree_cache->entry( $set_name );
  86 }
  87
  88 =head2 organism_tree_image
  89
  90 Public Path: /organism/tree/<set_name>/image
  91
  92 Get a PNG organism tree image
  93
  94 =cut
  95
  96 sub organism_tree_image :Chained('get_organism_tree') :PathPart('image') {
  97     my ( $self, $c ) = @_;
  98
  99     my $image = $c->stash->{organism_tree_cache_entry}->thaw
 100         or $c->throw_404;
 101
 102     $image->{png} or die "no png data for organism set '".$c->stash->{organism_set_name}."'! cannot serve image.  Dump of cache entry: \n".Data::Dumper::Dumper( $image );
 103
 104     $c->res->body( $image->{png} );
 105     $c->res->content_type( 'image/png' );
 106 }
 107
 108 =head2 clear_organism_tree
 109
 110 Public Path: /organism/tree/<set_name>/flush
 111
 112 Flush a cached organism tree image, so that the next call to serve the
 113 organism tree image or html will regenerate it.
 114
 115 =cut
 116
 117 # /organism/tree/<set_name>/flush
 118 sub clear_organism_tree :Chained('get_organism_tree') :PathPart('flush') {
 119     my ( $self, $c ) = @_;
 120
 121     $c->stash->{organism_tree_cache_entry}->remove;
 122     $c->res->content_type('application/json');
 123     $c->res->body(<<'');
 124 { status: "success" }
 125
 126 }
 127
 128
 129 =head2 view_sol100
 130
 131 Public Path: /organism/sol100/view
 132
 133 Display the sol100 organisms page.
 134
 135 =cut
 136
 137 sub view_sol100 :Path('sol100/view') :Args(0) {
 138     my ( $self, $c ) = @_;
 139
 140     my ($person_id, $user_type) = CXGN::Login->new( $c->dbc->dbh )->has_session();
 141     print STDERR "ACTION: ".$self->action_for('organism_tree_image')."\n";
 142
 143     print STDERR "IMAGE URI: ".$c->uri_for( $self->action_for('organism_tree_image'), ['sol100'] )->relative()."\n";
 144
 145     $c->stash({
 146         template => "/sequencing/sol100.mas",
 147
 148
 149
 150         organism_tree => {
 151             %{ $self->rendered_organism_tree_cache->thaw( 'sol100' ) },
 152
 153
 154
 155             image_uri => $c->uri_for( $self->action_for('organism_tree_image'), ['sol100'] )->relative(),
 156         },
 157
 158         show_org_add_form         => ( $user_type && any {$user_type eq $_} qw( curator submitter sequencer ) ),
 159         organism_add_uri          => '/organism/sol100/add_organism', #$self->action_for('add_sol100_organism')),
 160         organism_autocomplete_uri => $c->uri_for( 'autocomplete'),#$self->action_for('autocomplete')), #, ['Solanaceae'])->relative(),
 161
 162     });
 163 }
 164
 165 =head2 add_sol100_organism
 166
 167 Public Path: /organism/sol100/add_organism
 168
 169 POST target to add an organism to the set of sol100 organisms.  Takes
 170 one param, C<species>, which is the exact string species name in the
 171 DB.
 172
 173 After adding, redirects to C<view_sol100>.
 174
 175 =cut
 176
 177 sub add_sol100_organism :Path('sol100/add_organism') :Args(0) {
 178     my ( $self, $c ) = @_;
 179
 180     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 181     my $organism = $c->dbic_schema('Bio::Chado::Schema','sgn_chado', $sp_person_id)
 182                      ->resultset('Organism::Organism')
 183                      ->search({ species => { ilike => $c->req->body_parameters->{species} }})
 184                      ->single;
 185
 186     ## validate our conditions
 187     my @validate = ( [ RC_METHOD_NOT_ALLOWED,
 188                        'Only POST requests are allowed for this page.',
 189                        sub { $c->req->method eq 'POST' }
 190                      ],
 191                      [ RC_BAD_REQUEST,
 192                        'Organism not found',
 193                        sub { $organism },
 194                      ],
 195                     );
 196     for (@validate) {
 197         my ( $status, $message, $test ) = @$_;
 198         unless( $test->() ) {
 199             $c->throw( http_status => $status, public_message => $message );
 200             return;
 201         }
 202     }
 203
 204     # if this fails, it will throw an acception and will (probably
 205     # rightly) be counted as a server error
 206     $organism->create_organismprops(
 207         { 'sol100' => 1 },
 208         { autocreate => 1 },
 209        );
 210
 211     $self->rendered_organism_tree_cache->remove( 'sol100' ); #< invalidate the sol100 cached image tree
 212     $c->res->redirect( $c->uri_for( $self->action_for('view_sol100'))->relative());
 213 }
 214
 215
 216 sub invalidate_organism_tree_cache :Args(0) {
 217     my ($self, $c) = @_;
 218     $self->rendered_organism_tree_cache->remove( 'sol100' ); #< invalidate the sol100 cached image tree
 219     return;
 220 }
 221
 222
 223 #Chaining base to fetch a particular organism, chaining onto this like
 224 #/organism/<org_id>/<more_stuff>
 225 sub find_organism :Chained('/') :PathPart('organism') :CaptureArgs(1) {
 226     my ( $self, $c, $organism_id ) = @_;
 227
 228     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 229     my $rs =
 230         $c->dbic_schema('CXGN::Biosource::Schema','sgn_chado', $sp_person_id)
 231           ->resultset('Organism::Organism');
 232
 233     if( $organism_id =~ /\D/ ) {
 234         (my $species = $organism_id) =~ s/_/ /g;
 235         $rs = $rs->search_rs({ 'lower(me.species)' => lc $species });
 236     } else {
 237         $rs = $rs->search_rs({ organism_id => $organism_id });
 238     }
 239
 240     my ( $organism ) = my @organisms = $rs->all;
 241     $c->throw_client_error('Multiple matching organisms') if @organisms > 1;
 242     $c->throw_404('Organism not found') unless $organism;
 243
 244     $c->stash(
 245         organism_rs => $rs,
 246         organism_id => $organism->organism_id,
 247         organism    => $organism,
 248         );
 249 }
 250
 251 =head2 view_organism
 252
 253 Public Path: /organism/<organism_id>/view
 254
 255 Action for viewing an organism detail page.  Currently just redirects
 256 to the legacy /chado/organism.pl.
 257
 258 =cut
 259
 260 sub view_organism :Chained('find_organism') :PathPart('view') :Args(0) {
 261     my ( $self, $c ) = @_;
 262
 263     return unless $c->stash->{organism_id};
 264
 265     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 266     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado', $sp_person_id);
 267     my $organism = CXGN::Chado::Organism->new($schema, $c->stash->{organism_id});
 268     $c->stash->{organism} = $organism;
 269     $c->stash->{na}= qq| <span class="ghosted">N/A</span> |;
 270     $c->stash->{genus} = $c->stash->{organism_rs}->first()->genus();
 271     $c->stash->{taxon} = $organism->get_taxon();
 272     $c->stash->{organism_name} = $c->stash->{organism_rs}->first()->species();
 273
 274     my $common_name = $c->stash->{organism_rs}->first()->common_name();
 275     $c->stash->{common_name} = lc($common_name);
 276     $common_name = ucfirst($common_name);
 277     $c->stash->{comment} = $c->stash->{organism_rs}->first()->comment();
 278
 279     my $organismprop_rs = $schema->resultset('Organism::Organismprop')->search( { organism_id=>$c->stash->{organism_id} });
 280
 281     $c->stash->{description} = CXGN::Tools::Text::format_field_text($organism->get_comment());
 282
 283     @{$c->stash->{synonyms}} = $organism->get_synonyms();
 284
 285     $c->stash->{loci} = "<a href=\"/search/locus\">".$organism->get_loci_count().'</a>';
 286
 287     $c->stash->{taxonomy} = join ", ", reverse(get_parentage($organism));
 288
 289     my $accessions;
 290     my @dbxrefs = $organism->get_dbxrefs();
 291     my $solcyc_link;
 292
 293     foreach my $dbxref (@dbxrefs) {
 294         my $accession = $dbxref->accession();
 295         my ($db)      = $dbxref->search_related("db");
 296         my $db_name   = $db->name();
 297         my $full_url  = $db->urlprefix . $db->url();
 298
 299         if ( $db_name =~ m/(DB:)(.*)/ ) {
 300             $db_name = $2;
 301             $db_name =~ s/_/ /g;
 302
 303             $accessions .=
 304                 qq|<a href= "$full_url$accession">$db_name ID: $accession</a ><br />|;
 305         }
 306         if ( $db_name eq 'SolCyc_by_species' ) {
 307             my $solcyc = $accession;
 308             $solcyc =~ s/\///g;
 309             $solcyc =~ s/$solcyc/\u\L$solcyc/g;
 310             $solcyc      = $solcyc . "Cyc";
 311             $solcyc_link = "See <a href=\"$full_url$accession\">$solcyc</a>";
 312         }
 313     }
 314
 315     my $logged_user = $c->user;
 316     my $person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 317     my $privileged_user =  ($logged_user && ( $logged_user->check_roles('curator') || $logged_user->check_roles('sequencer') || $logged_user->check_roles('submitter') ) )  ;
 318
 319     $c->stash->{privileged_user} = $privileged_user;
 320
 321     $c->stash->{solcyc_link} = $solcyc_link;
 322     $c->stash->{accessions} = $accessions;
 323     my $na      = qq| <span class="ghosted">N/A</span> |;
 324     $c->stash->{ploidy} = $organism->get_ploidy() || $na;
 325     $c->stash->{genome_size} = $organism->get_genome_size() || $na;
 326     $c->stash->{chromosome_number} = $organism->get_chromosome_number() || $na;
 327     my @image_ids = $organism->get_image_ids();
 328     $c->stash->{images} = \@image_ids;
 329     $self->map_data($c);
 330     $self->transcript_data($c);
 331     $self->phenotype_data($c);
 332     $self->qtl_data($c);
 333
 334 }
 335
 336 sub map_data {
 337     my $self = shift;
 338     my $c = shift;
 339     my $maps;
 340     my @map_data = $c->stash->{organism}->get_map_data();
 341     foreach my $info (@map_data) {
 342         my $map_id     = $info->[1];
 343         my $short_name = $info->[0];
 344         $maps .= "<a href=\"/cview/map.pl?map_id=$map_id\">$short_name</a><br />";
 345     }
 346     $c->stash->{maps} = $maps;
 347 }
 348
 349 sub transcript_data {
 350     my $self = shift;
 351     my $c = shift;
 352
 353     my @libraries = $c->stash->{organism}->get_library_list();
 354
 355     my $attribution = $c->stash->{organism}->get_est_attribution();
 356
 357     $c->stash->{libraries} = \@libraries;
 358     $c->stash->{est_attribution}  = $attribution;
 359
 360 }
 361
 362 sub qtl_data {
 363     my $self = shift;
 364     my $c = shift;
 365
 366
 367     ####################### QTL DISPLAY #############
 368     my $common_name = $c->stash->{common_name};
 369     my @qtl_data = qtl_populations($common_name);
 370     unless (@qtl_data) { @qtl_data = ['N/A', 'N/A'];}
 371
 372
 373     $c->stash->{qtl_data} = \@qtl_data;
 374 }
 375
 376 sub phenotype_data {
 377     my $self = shift;
 378     my $c = shift;
 379     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 380     my $schema = $c->dbic_schema('Bio::Chado::Schema','sgn_chado', $sp_person_id);
 381     my $organism = $c->stash->{organism};
 382     my $organism_id = $organism->get_organism_id;
 383     my $pheno_count = $organism->get_phenotype_count();
 384     my $onto_count  = $schema->resultset("Stock::StockCvterm")->search_related('stock', {
 385         organism_id => $organism_id } )->count;
 386     my $trait_count = $schema->resultset("NaturalDiversity::NdExperimentPhenotype")->search_related('nd_experiment')->search_related('nd_experiment_stocks')->search_related('stock', { organism_id => $organism_id } )->count;
 387
 388     my $pheno_list =
 389         qq|<a href= "/search/stocks?organism=$organism_id">$pheno_count</a>|;
 390     $c->stash->{phenotypes}  = $pheno_list;
 391     my $onto_list =
 392         qq|<a href= "/search/stocks?organism=$organism_id">$onto_count</a>|;
 393     $c->stash->{onto_count}  = $onto_list;
 394     my $trait_list =
 395         qq|<a href= "/search/stocks?organism=$organism_id">$trait_count</a>|;
 396     $c->stash->{trait_count} = $trait_list;
 397
 398 }
 399
 400
 401 =head1 ATTRIBUTES
 402
 403 =head2 organism_sets
 404
 405 a hashref of organism sets (DBIC resultsets) as:
 406
 407   { set_name => {
 408            description => 'user-visible description string for the set',
 409            resultset => DBIC resultset of organisms in that set,
 410          },
 411   }
 412
 413 currently defined sets are:
 414
 415 =head3 sol100
 416
 417 the SOL100 organisms, which are organisms in solanaceae that have a
 418 'web visible' organismprop set
 419
 420 =head3 Solanaceae
 421
 422 all organisms in the Solanaceae family
 423
 424 =head3 Rubiaceae
 425
 426 all organisms in the Rubiaceae family
 427
 428 =head3 Plantaginaceae
 429
 430 all organisms in the Plantaginaceae family
 431
 432 =head3 web_visible_Solanaceae
 433
 434 organisms in Solanaceae that have their 'web visible' organismprop set
 435
 436 =head3 web_visible_Rubiaceae
 437
 438 organisms in Rubiaceae that have their 'web visible' organismprop set
 439
 440 =head3 web_visible_Plantaginaceae
 441
 442 organisms in Plantaginaceae that have their 'web visible' organismprop set
 443
 444 =cut
 445
 446 has 'organism_sets' => (
 447     is => 'ro',
 448     isa => 'HashRef',
 449     lazy_build => 1,
 450    ); sub _build_organism_sets {
 451         my $self = shift;
 452         my $c = shift;
 453         my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 454         my $schema = $self->_app->dbic_schema('Bio::Chado::Schema','sgn_chado', $sp_person_id);
 455         my %org_sets;
 456
 457         # define a set of SOL100 organisms
 458         $org_sets{'sol100'} = {
 459             description => 'SOL100 Organisms',
 460             root_species => 'Solanaceae',
 461             resultset => $schema->resultset( "Cv::Cvterm" )
 462                            ->search({ name => 'sol100' })
 463                            ->search_related( 'organismprops' )
 464                            ->search_related_rs( 'organism' )
 465         };
 466
 467         # define sets of web-visible organisms, by family
 468         for my $family (qw( Solanaceae  Rubiaceae  Plantaginaceae )) {
 469             my $pns = $schema->resultset('Organism::Organism')
 470                             ->search({ 'me.species' => $family })
 471                             ->search_related('phylonode_organisms')
 472                             ->search_related('phylonode',
 473                                              { 'cv.name' => 'taxonomy' },
 474                                              { join => { type => 'cv' }},
 475                                             );
 476
 477             $pns = $self->_child_phylonodes( $pns )
 478                         ->search_related_rs('phylonode_organism');
 479
 480             # set of all organisms in that family
 481             $org_sets{$family} = {
 482                 description  => $family,
 483                 root_species => $family,
 484                 resultset    => $pns->search_related_rs('organism'),
 485             };
 486
 487             # set of only web-visible organisms in that family
 488             $org_sets{"web_visible_$family"} = {
 489                 description  => $family,
 490                 root_species => $family,
 491                 resultset    => $pns->search_related_rs(
 492                     'organism',
 493                     { 'cv.name'   => 'local',
 494                       'type.name' => 'web visible',
 495                     },
 496                     { join => { organismprops => { type => 'cv' }}},
 497                    )
 498                };
 499         }
 500         return \%org_sets;
 501     }
 502
 503 # take a resultset of phylonodes, construct a resultset of the child
 504 # phylonodes.  temporary workaround until the extended_rels branch is
 505 # merged into DBIx::Class and DBIx::Class::Tree::NestedSet is ported
 506 # to use it
 507 sub _child_phylonodes {
 508     my ( $self, $phylonodes ) = @_;
 509
 510     my %child_phylonode_conditions;
 511     while( my $pn = $phylonodes->next ) {
 512         push @{ $child_phylonode_conditions{ '-or' }} => {
 513             'left_idx'     => { '>' => $pn->left_idx  },
 514             'right_idx'    => { '<' => $pn->right_idx },
 515             'phylotree_id' => $pn->phylotree_id,
 516         };
 517     }
 518
 519     return $phylonodes->result_source->resultset
 520         ->search( \%child_phylonode_conditions );
 521 }
 522
 523
 524 =head2 species_data_summary_cache
 525
 526 L<Cache> object containing species data summaries, as:
 527
 528   {
 529     <organism_id> => {
 530          'Common Name' => common_name,
 531           ...
 532     },
 533     ...
 534   }
 535
 536 Access with  C<$controller-E<gt>species_data_summary_cache->thaw($organism_id )>,
 537 do not use Cache's C<get> method.
 538
 539 =cut
 540
 541 has 'species_data_summary_cache' => (
 542     is  => 'ro',
 543     lazy_build => 1,
 544    ); sub _build_species_data_summary_cache {
 545        my ($cache_class, $config) = shift->_species_summary_cache_configuration;
 546        return $cache_class->new( %$config );
 547    }
 548
 549 sub _species_summary_cache_configuration {
 550     my ( $self, $c ) = @_;
 551
 552     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 553     my $schema   = $self->_app->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado', $sp_person_id);
 554
 555     return 'Cache::File', {
 556         cache_root      => $self->_app->path_to( $self->_app->tempfiles_subdir('species_summary_cache') ),
 557         default_expires => '6 hours',
 558
 559         load_callback   => sub {
 560             my $cache_entry = shift;
 561             my $org_id = $cache_entry->key;
 562             my $org = CXGN::Chado::Organism->new( $schema, $org_id )
 563                 or return;
 564             no warnings 'uninitialized';
 565             return Storable::nfreeze({
 566                 'Common Name' => $org->get_group_common_name,
 567                 'Loci' => $org->get_loci_count,
 568                 'Phenotypes' => $org->get_phenotype_count,
 569                 'Maps Available' => $org->has_avail_map,
 570                 'Genome Information' => $org->has_avail_genome ? 'yes': 'no',
 571                 'Libraries' => scalar( $org->get_library_list ),
 572             });
 573         },
 574     };
 575 }
 576
 577 =head2 rendered_organism_tree_cache
 578
 579 A cache of rendered organism trees, as
 580
 581    set_name  =>
 582     {
 583        newick         => 'newick string',
 584        png            => 'png data',
 585        image_map      => 'html image map',
 586        image_map_name => 'name of the image map for <img usemap="" ... />',
 587      }
 588
 589 =cut
 590
 591 has 'rendered_organism_tree_cache' => (
 592     is => 'ro',
 593     lazy_build => 1,
 594    ); sub _build_rendered_organism_tree_cache {
 595         my ( $self, $c ) = @_;
 596         my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 597
 598         Cache::File->new(
 599             cache_root      => $self->_app->path_to( $self->_app->tempfiles_subdir('cache','rendered_organism_tree_cache') ),
 600             default_expires => 'never',
 601
 602             load_callback => sub {
 603                 my $set_name = shift->key;
 604                 my $set = $self->organism_sets->{ $set_name };
 605                 my $root_species  = $set->{root_species} or die "no root species defined for org set $set_name";
 606                 my $species_names = [ $set->{resultset}->get_column('species')->all ];
 607
 608                 if( @$species_names ) {
 609                     my $orgtree = $self->_render_organism_tree(
 610                         $self->_app->dbic_schema('Bio::Chado::Schema','sgn_chado', $sp_person_id),
 611                         $root_species,
 612                         $species_names,
 613                        );
 614                     return Storable::nfreeze( $orgtree );
 615                 }
 616                 else {
 617                     return Storable::nfreeze( {} );
 618                 }
 619             },
 620            );
 621     }
 622
 623 # takes dbic schema, root species name, arrayref of species names to
 624 # render returns hashref of newick string, png data, and an HTML image
 625 # map
 626 # returns hashref of
 627 # {
 628 #    newick         => 'newick string',
 629 #    png            => 'png data',
 630 #    image_map      => 'html image map',
 631 #    image_map_name => 'name of the image map for <img usemap="" ... />',
 632 # }
 633 sub _render_organism_tree {
 634     my ( $self, $schema, $root_species, $species_names ) = @_;
 635
 636     $self->_app->log->debug( "rendering org for root species '$root_species'" ) if $self->_app->debug;
 637
 638     my $tree = CXGN::Phylo::OrganismTree->new( $schema );
 639
 640     try {
 641         my $newick_string = $tree->build_tree(
 642             $root_species,
 643             $species_names,
 644             $self->species_data_summary_cache,
 645            );
 646
 647         my $cache = $self->species_data_summary_cache();
 648         foreach my $n (@$species_names) {
 649             my $ors = CXGN::Chado::Organism::get_organism_by_species($n, $schema);
 650             # $o is a resultset
 651             if ($ors) {
 652                 my $genome_info = $cache->thaw($ors->organism_id())->{'Genome Information'};
 653                 if ($genome_info =~ /y/i) {
 654                     $tree->hilite_species([170,220,180], [$n]);
 655                 }
 656             }
 657         }
 658         my $image_map_name = $root_species.'_map';
 659         my $image_map = $tree->get_renderer
 660             ->get_html_image_map( $image_map_name );
 661         my $image_png = $tree->render_png( undef, 1 );
 662
 663         return {
 664             newick    => $newick_string,
 665             png       => $image_png,
 666             image_map => $image_map,
 667             image_map_name => $image_map_name,
 668         };
 669     } catch {
 670         warn $_;
 671         return;
 672     }
 673 }
 674
 675
 676 =head2 qtl_populations
 677
 678  Usage: my @qtl_data = qtl_populations($common_name);
 679  Desc:  returns a list of qtl populations (hyperlinked to the pop page)
 680         and counts of traits assayed for QTL for the corresponding population
 681  Ret: an array of array of populations and trait counts or undef
 682  Args: organism group common name
 683  Side Effects:
 684  Example:
 685
 686 =cut
 687
 688
 689
 690 sub qtl_populations {
 691     my $gr_common_name = shift;
 692     my $qtl_tool       = CXGN::Phenome::Qtl::Tools->new();
 693
 694     my @org_pops       = $qtl_tool->qtl_pops_by_common_name($gr_common_name);
 695     my @pop_data;
 696
 697     if (@org_pops) {
 698         foreach my $org_pop (@org_pops) {
 699             my $pop_id   = $org_pop->get_population_id();
 700             my $pop_name = $org_pop->get_name();
 701             my $pop_link = qq |<a href="/qtl/view/$pop_id">$pop_name</a>|;
 702             my @traits   = $org_pop->get_cvterms();
 703             my $count    = scalar(@traits);
 704
 705             push @pop_data, [ map { $_ } ( $pop_link, $count ) ];
 706         }
 707
 708     }
 709     return @pop_data;
 710 }
 711
 712 sub get_parentage {
 713
 714     my $organism = shift;
 715     my $parent   = $organism->get_parent();
 716
 717     my @taxonomy;
 718     if ($parent) {
 719         my $species = $parent->get_species();
 720         my $taxon   = $parent->get_taxon();
 721
 722         push @taxonomy,  tooltipped_text( $species, $taxon );
 723         @taxonomy = (@taxonomy, get_parentage($parent));
 724     }
 725     return @taxonomy;
 726 }
 727
 728 __PACKAGE__->meta->make_immutable;
 729
 730 1;