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 $organism = $c->dbic_schema('Bio::Chado::Schema','sgn_chado')
 181                      ->resultset('Organism::Organism')
 182                      ->search({ species => { ilike => $c->req->body_parameters->{species} }})
 183                      ->single;
 184
 185     ## validate our conditions
 186     my @validate = ( [ RC_METHOD_NOT_ALLOWED,
 187                        'Only POST requests are allowed for this page.',
 188                        sub { $c->req->method eq 'POST' }
 189                      ],
 190                      [ RC_BAD_REQUEST,
 191                        'Organism not found',
 192                        sub { $organism },
 193                      ],
 194                     );
 195     for (@validate) {
 196         my ( $status, $message, $test ) = @$_;
 197         unless( $test->() ) {
 198             $c->throw( http_status => $status, public_message => $message );
 199             return;
 200         }
 201     }
 202
 203     # if this fails, it will throw an acception and will (probably
 204     # rightly) be counted as a server error
 205     $organism->create_organismprops(
 206         { 'sol100' => 1 },
 207         { autocreate => 1 },
 208        );
 209
 210     $self->rendered_organism_tree_cache->remove( 'sol100' ); #< invalidate the sol100 cached image tree
 211     $c->res->redirect( $c->uri_for( $self->action_for('view_sol100'))->relative());
 212 }
 213
 214
 215 sub invalidate_organism_tree_cache :Args(0) {
 216     my ($self, $c) = @_;
 217     $self->rendered_organism_tree_cache->remove( 'sol100' ); #< invalidate the sol100 cached image tree
 218     return;
 219 }
 220
 221
 222 #Chaining base to fetch a particular organism, chaining onto this like
 223 #/organism/<org_id>/<more_stuff>
 224 sub find_organism :Chained('/') :PathPart('organism') :CaptureArgs(1) {
 225     my ( $self, $c, $organism_id ) = @_;
 226
 227     my $rs =
 228         $c->dbic_schema('CXGN::Biosource::Schema','sgn_chado')
 229           ->resultset('Organism::Organism');
 230
 231     if( $organism_id =~ /\D/ ) {
 232         (my $species = $organism_id) =~ s/_/ /g;
 233         $rs = $rs->search_rs({ 'lower(me.species)' => lc $species });
 234     } else {
 235         $rs = $rs->search_rs({ organism_id => $organism_id });
 236     }
 237
 238     my ( $organism ) = my @organisms = $rs->all;
 239     $c->throw_client_error('Multiple matching organisms') if @organisms > 1;
 240     $c->throw_404('Organism not found') unless $organism;
 241
 242     $c->stash(
 243         organism_rs => $rs,
 244         organism_id => $organism->organism_id,
 245         organism    => $organism,
 246         );
 247 }
 248
 249 =head2 view_organism
 250
 251 Public Path: /organism/<organism_id>/view
 252
 253 Action for viewing an organism detail page.  Currently just redirects
 254 to the legacy /chado/organism.pl.
 255
 256 =cut
 257
 258 sub view_organism :Chained('find_organism') :PathPart('view') :Args(0) {
 259     my ( $self, $c ) = @_;
 260
 261     return unless $c->stash->{organism_id};
 262
 263     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 264     my $organism = CXGN::Chado::Organism->new($schema, $c->stash->{organism_id});
 265     $c->stash->{organism} = $organism;
 266     $c->stash->{na}= qq| <span class="ghosted">N/A</span> |;
 267     $c->stash->{genus} = $c->stash->{organism_rs}->first()->genus();
 268     $c->stash->{taxon} = $organism->get_taxon();
 269     $c->stash->{organism_name} = $c->stash->{organism_rs}->first()->species();
 270
 271     my $common_name = $c->stash->{organism_rs}->first()->common_name();
 272     $c->stash->{common_name} = lc($common_name);
 273     $common_name = ucfirst($common_name);
 274     $c->stash->{comment} = $c->stash->{organism_rs}->first()->comment();
 275
 276     my $organismprop_rs = $schema->resultset('Organism::Organismprop')->search( { organism_id=>$c->stash->{organism_id} });
 277
 278     $c->stash->{description} = CXGN::Tools::Text::format_field_text($organism->get_comment());
 279
 280     @{$c->stash->{synonyms}} = $organism->get_synonyms();
 281
 282     $c->stash->{loci} = "<a href=\"/search/locus\">".$organism->get_loci_count().'</a>';
 283
 284     $c->stash->{taxonomy} = join ", ", reverse(get_parentage($organism));
 285
 286     my $accessions;
 287     my @dbxrefs = $organism->get_dbxrefs();
 288     my $solcyc_link;
 289
 290     foreach my $dbxref (@dbxrefs) {
 291         my $accession = $dbxref->accession();
 292         my ($db)      = $dbxref->search_related("db");
 293         my $db_name   = $db->name();
 294         my $full_url  = $db->urlprefix . $db->url();
 295
 296         if ( $db_name =~ m/(DB:)(.*)/ ) {
 297             $db_name = $2;
 298             $db_name =~ s/_/ /g;
 299
 300             $accessions .=
 301                 qq|<a href= "$full_url$accession">$db_name ID: $accession</a ><br />|;
 302         }
 303         if ( $db_name eq 'SolCyc_by_species' ) {
 304             my $solcyc = $accession;
 305             $solcyc =~ s/\///g;
 306             $solcyc =~ s/$solcyc/\u\L$solcyc/g;
 307             $solcyc      = $solcyc . "Cyc";
 308             $solcyc_link = "See <a href=\"$full_url$accession\">$solcyc</a>";
 309         }
 310     }
 311
 312     my $logged_user = $c->user;
 313     my $person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 314     my $privileged_user =  ($logged_user && ( $logged_user->check_roles('curator') || $logged_user->check_roles('sequencer') || $logged_user->check_roles('submitter') ) )  ;
 315
 316     $c->stash->{privileged_user} = $privileged_user;
 317
 318     $c->stash->{solcyc_link} = $solcyc_link;
 319     $c->stash->{accessions} = $accessions;
 320     my $na      = qq| <span class="ghosted">N/A</span> |;
 321     $c->stash->{ploidy} = $organism->get_ploidy() || $na;
 322     $c->stash->{genome_size} = $organism->get_genome_size() || $na;
 323     $c->stash->{chromosome_number} = $organism->get_chromosome_number() || $na;
 324     my @image_ids = $organism->get_image_ids();
 325     my @image_objects = map { SGN::Image->new($c->dbc->dbh, $_, $c ) } @image_ids;
 326     $c->stash->{image_objects} = \@image_objects;
 327     $self->map_data($c);
 328     $self->transcript_data($c);
 329     $self->phenotype_data($c);
 330     $self->qtl_data($c);
 331
 332 }
 333
 334 sub map_data {
 335     my $self = shift;
 336     my $c = shift;
 337     my $maps;
 338     my @map_data = $c->stash->{organism}->get_map_data();
 339     foreach my $info (@map_data) {
 340         my $map_id     = $info->[1];
 341         my $short_name = $info->[0];
 342         $maps .= "<a href=\"/cview/map.pl?map_id=$map_id\">$short_name</a><br />";
 343     }
 344     $c->stash->{maps} = $maps;
 345 }
 346
 347 sub transcript_data {
 348     my $self = shift;
 349     my $c = shift;
 350
 351     my @libraries = $c->stash->{organism}->get_library_list();
 352
 353     my $attribution = $c->stash->{organism}->get_est_attribution();
 354
 355     $c->stash->{libraries} = \@libraries;
 356     $c->stash->{est_attribution}  = $attribution;
 357
 358 }
 359
 360 sub qtl_data {
 361     my $self = shift;
 362     my $c = shift;
 363
 364
 365     ####################### QTL DISPLAY #############
 366     my $common_name = $c->stash->{common_name};
 367     my @qtl_data = qtl_populations($common_name);
 368     unless (@qtl_data) { @qtl_data = ['N/A', 'N/A'];}
 369
 370
 371     $c->stash->{qtl_data} = \@qtl_data;
 372 }
 373
 374 sub phenotype_data {
 375     my $self = shift;
 376     my $c = shift;
 377     my $schema = $c->dbic_schema('Bio::Chado::Schema','sgn_chado');
 378     my $organism = $c->stash->{organism};
 379     my $organism_id = $organism->get_organism_id;
 380     my $pheno_count = $organism->get_phenotype_count();
 381     my $onto_count  = $schema->resultset("Stock::StockCvterm")->search_related('stock', {
 382         organism_id => $organism_id } )->count;
 383     my $trait_count = $schema->resultset("NaturalDiversity::NdExperimentPhenotype")->search_related('nd_experiment')->search_related('nd_experiment_stocks')->search_related('stock', { organism_id => $organism_id } )->count;
 384
 385     my $pheno_list =
 386         qq|<a href= "/search/stocks?organism=$organism_id">$pheno_count</a>|;
 387     $c->stash->{phenotypes}  = $pheno_list;
 388     my $onto_list =
 389         qq|<a href= "/search/stocks?organism=$organism_id">$onto_count</a>|;
 390     $c->stash->{onto_count}  = $onto_list;
 391     my $trait_list =
 392         qq|<a href= "/search/stocks?organism=$organism_id">$trait_count</a>|;
 393     $c->stash->{trait_count} = $trait_list;
 394
 395 }
 396
 397
 398 =head1 ATTRIBUTES
 399
 400 =head2 organism_sets
 401
 402 a hashref of organism sets (DBIC resultsets) as:
 403
 404   { set_name => {
 405            description => 'user-visible description string for the set',
 406            resultset => DBIC resultset of organisms in that set,
 407          },
 408   }
 409
 410 currently defined sets are:
 411
 412 =head3 sol100
 413
 414 the SOL100 organisms, which are organisms in solanaceae that have a
 415 'web visible' organismprop set
 416
 417 =head3 Solanaceae
 418
 419 all organisms in the Solanaceae family
 420
 421 =head3 Rubiaceae
 422
 423 all organisms in the Rubiaceae family
 424
 425 =head3 Plantaginaceae
 426
 427 all organisms in the Plantaginaceae family
 428
 429 =head3 web_visible_Solanaceae
 430
 431 organisms in Solanaceae that have their 'web visible' organismprop set
 432
 433 =head3 web_visible_Rubiaceae
 434
 435 organisms in Rubiaceae that have their 'web visible' organismprop set
 436
 437 =head3 web_visible_Plantaginaceae
 438
 439 organisms in Plantaginaceae that have their 'web visible' organismprop set
 440
 441 =cut
 442
 443 has 'organism_sets' => (
 444     is => 'ro',
 445     isa => 'HashRef',
 446     lazy_build => 1,
 447    ); sub _build_organism_sets {
 448         my $self = shift;
 449         my $schema = $self->_app->dbic_schema('Bio::Chado::Schema','sgn_chado');
 450         my %org_sets;
 451
 452         # define a set of SOL100 organisms
 453         $org_sets{'sol100'} = {
 454             description => 'SOL100 Organisms',
 455             root_species => 'Solanaceae',
 456             resultset => $schema->resultset( "Cv::Cvterm" )
 457                            ->search({ name => 'sol100' })
 458                            ->search_related( 'organismprops' )
 459                            ->search_related_rs( 'organism' )
 460         };
 461
 462         # define sets of web-visible organisms, by family
 463         for my $family (qw( Solanaceae  Rubiaceae  Plantaginaceae )) {
 464             my $pns = $schema->resultset('Organism::Organism')
 465                             ->search({ 'me.species' => $family })
 466                             ->search_related('phylonode_organisms')
 467                             ->search_related('phylonode',
 468                                              { 'cv.name' => 'taxonomy' },
 469                                              { join => { type => 'cv' }},
 470                                             );
 471
 472             $pns = $self->_child_phylonodes( $pns )
 473                         ->search_related_rs('phylonode_organism');
 474
 475             # set of all organisms in that family
 476             $org_sets{$family} = {
 477                 description  => $family,
 478                 root_species => $family,
 479                 resultset    => $pns->search_related_rs('organism'),
 480             };
 481
 482             # set of only web-visible organisms in that family
 483             $org_sets{"web_visible_$family"} = {
 484                 description  => $family,
 485                 root_species => $family,
 486                 resultset    => $pns->search_related_rs(
 487                     'organism',
 488                     { 'cv.name'   => 'local',
 489                       'type.name' => 'web visible',
 490                     },
 491                     { join => { organismprops => { type => 'cv' }}},
 492                    )
 493                };
 494         }
 495         return \%org_sets;
 496     }
 497
 498 # take a resultset of phylonodes, construct a resultset of the child
 499 # phylonodes.  temporary workaround until the extended_rels branch is
 500 # merged into DBIx::Class and DBIx::Class::Tree::NestedSet is ported
 501 # to use it
 502 sub _child_phylonodes {
 503     my ( $self, $phylonodes ) = @_;
 504
 505     my %child_phylonode_conditions;
 506     while( my $pn = $phylonodes->next ) {
 507         push @{ $child_phylonode_conditions{ '-or' }} => {
 508             'left_idx'     => { '>' => $pn->left_idx  },
 509             'right_idx'    => { '<' => $pn->right_idx },
 510             'phylotree_id' => $pn->phylotree_id,
 511         };
 512     }
 513
 514     return $phylonodes->result_source->resultset
 515         ->search( \%child_phylonode_conditions );
 516 }
 517
 518
 519 =head2 species_data_summary_cache
 520
 521 L<Cache> object containing species data summaries, as:
 522
 523   {
 524     <organism_id> => {
 525          'Common Name' => common_name,
 526           ...
 527     },
 528     ...
 529   }
 530
 531 Access with  C<$controller-E<gt>species_data_summary_cache->thaw($organism_id )>,
 532 do not use Cache's C<get> method.
 533
 534 =cut
 535
 536 has 'species_data_summary_cache' => (
 537     is  => 'ro',
 538     lazy_build => 1,
 539    ); sub _build_species_data_summary_cache {
 540        my ($cache_class, $config) = shift->_species_summary_cache_configuration;
 541        return $cache_class->new( %$config );
 542    }
 543
 544 sub _species_summary_cache_configuration {
 545     my ($self) = @_;
 546
 547     my $schema   = $self->_app->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado' );
 548
 549     return 'Cache::File', {
 550         cache_root      => $self->_app->path_to( $self->_app->tempfiles_subdir('species_summary_cache') ),
 551         default_expires => '6 hours',
 552
 553         load_callback   => sub {
 554             my $cache_entry = shift;
 555             my $org_id = $cache_entry->key;
 556             my $org = CXGN::Chado::Organism->new( $schema, $org_id )
 557                 or return;
 558             no warnings 'uninitialized';
 559             return Storable::nfreeze({
 560                 'Common Name' => $org->get_group_common_name,
 561                 'Loci' => $org->get_loci_count,
 562                 'Phenotypes' => $org->get_phenotype_count,
 563                 'Maps Available' => $org->has_avail_map,
 564                 'Genome Information' => $org->has_avail_genome ? 'yes': 'no',
 565                 'Libraries' => scalar( $org->get_library_list ),
 566             });
 567         },
 568     };
 569 }
 570
 571 =head2 rendered_organism_tree_cache
 572
 573 A cache of rendered organism trees, as
 574
 575    set_name  =>
 576     {
 577        newick         => 'newick string',
 578        png            => 'png data',
 579        image_map      => 'html image map',
 580        image_map_name => 'name of the image map for <img usemap="" ... />',
 581      }
 582
 583 =cut
 584
 585 has 'rendered_organism_tree_cache' => (
 586     is => 'ro',
 587     lazy_build => 1,
 588    ); sub _build_rendered_organism_tree_cache {
 589         my ( $self ) = @_;
 590
 591         Cache::File->new(
 592             cache_root      => $self->_app->path_to( $self->_app->tempfiles_subdir('cache','rendered_organism_tree_cache') ),
 593             default_expires => 'never',
 594
 595             load_callback => sub {
 596                 my $set_name = shift->key;
 597                 my $set = $self->organism_sets->{ $set_name };
 598                 my $root_species  = $set->{root_species} or die "no root species defined for org set $set_name";
 599                 my $species_names = [ $set->{resultset}->get_column('species')->all ];
 600
 601                 if( @$species_names ) {
 602                     my $orgtree = $self->_render_organism_tree(
 603                         $self->_app->dbic_schema('Bio::Chado::Schema','sgn_chado'),
 604                         $root_species,
 605                         $species_names,
 606                        );
 607                     return Storable::nfreeze( $orgtree );
 608                 }
 609                 else {
 610                     return Storable::nfreeze( {} );
 611                 }
 612             },
 613            );
 614     }
 615
 616 # takes dbic schema, root species name, arrayref of species names to
 617 # render returns hashref of newick string, png data, and an HTML image
 618 # map
 619 # returns hashref of
 620 # {
 621 #    newick         => 'newick string',
 622 #    png            => 'png data',
 623 #    image_map      => 'html image map',
 624 #    image_map_name => 'name of the image map for <img usemap="" ... />',
 625 # }
 626 sub _render_organism_tree {
 627     my ( $self, $schema, $root_species, $species_names ) = @_;
 628
 629     $self->_app->log->debug( "rendering org for root species '$root_species'" ) if $self->_app->debug;
 630
 631     my $tree = CXGN::Phylo::OrganismTree->new( $schema );
 632
 633     try {
 634         my $newick_string = $tree->build_tree(
 635             $root_species,
 636             $species_names,
 637             $self->species_data_summary_cache,
 638            );
 639
 640         my $cache = $self->species_data_summary_cache();
 641         foreach my $n (@$species_names) {
 642             my $ors = CXGN::Chado::Organism::get_organism_by_species($n, $schema);
 643             # $o is a resultset
 644             if ($ors) {
 645                 my $genome_info = $cache->thaw($ors->organism_id())->{'Genome Information'};
 646                 if ($genome_info =~ /y/i) {
 647                     $tree->hilite_species([170,220,180], [$n]);
 648                 }
 649             }
 650         }
 651         my $image_map_name = $root_species.'_map';
 652         my $image_map = $tree->get_renderer
 653             ->get_html_image_map( $image_map_name );
 654         my $image_png = $tree->render_png( undef, 1 );
 655
 656         return {
 657             newick    => $newick_string,
 658             png       => $image_png,
 659             image_map => $image_map,
 660             image_map_name => $image_map_name,
 661         };
 662     } catch {
 663         warn $_;
 664         return;
 665     }
 666 }
 667
 668
 669 =head2 qtl_populations
 670
 671  Usage: my @qtl_data = qtl_populations($common_name);
 672  Desc:  returns a list of qtl populations (hyperlinked to the pop page)
 673         and counts of traits assayed for QTL for the corresponding population
 674  Ret: an array of array of populations and trait counts or undef
 675  Args: organism group common name
 676  Side Effects:
 677  Example:
 678
 679 =cut
 680
 681
 682
 683 sub qtl_populations {
 684     my $gr_common_name = shift;
 685     my $qtl_tool       = CXGN::Phenome::Qtl::Tools->new();
 686
 687     my @org_pops       = $qtl_tool->qtl_pops_by_common_name($gr_common_name);
 688     my @pop_data;
 689
 690     if (@org_pops) {
 691         foreach my $org_pop (@org_pops) {
 692             my $pop_id   = $org_pop->get_population_id();
 693             my $pop_name = $org_pop->get_name();
 694             my $pop_link = qq |<a href="/qtl/view/$pop_id">$pop_name</a>|;
 695             my @traits   = $org_pop->get_cvterms();
 696             my $count    = scalar(@traits);
 697
 698             push @pop_data, [ map { $_ } ( $pop_link, $count ) ];
 699         }
 700
 701     }
 702     return @pop_data;
 703 }
 704
 705 sub get_parentage {
 706
 707     my $organism = shift;
 708     my $parent   = $organism->get_parent();
 709
 710     my @taxonomy;
 711     if ($parent) {
 712         my $species = $parent->get_species();
 713         my $taxon   = $parent->get_taxon();
 714
 715         push @taxonomy,  tooltipped_text( $species, $taxon );
 716         @taxonomy = (@taxonomy, get_parentage($parent));
 717     }
 718     return @taxonomy;
 719 }
 720
 721 __PACKAGE__->meta->make_immutable;
 722
 723 1;