cgi-bin/phenome/allele.pl

   1 ######################################################################
   2 #
   3 #  Displays an editable allele detail page.
   4 #
   5 ######################################################################
   6
   7 my $allele_detail_page = CXGN::Phenome::AlleleDetailPage->new();
   8
   9 package CXGN::Phenome::AlleleDetailPage;
  10
  11 use base qw/CXGN::Page::Form::SimpleFormPage/;
  12
  13 use strict;
  14
  15 use CXGN::Page;
  16 use CXGN::Page::FormattingHelpers qw(info_section_html
  17                                      page_title_html
  18                                      columnar_table_html
  19                                      info_table_html
  20                                      html_optional_show
  21                                     );
  22
  23 use CXGN::Phenome::Locus;
  24 use CXGN::Phenome::Allele;
  25 use CXGN::Phenome::AlleleSynonym;
  26 use CXGN::Chado::Publication;
  27 use CXGN::People::PageComment;
  28 use CXGN::Feed;
  29 use SGN::Image;
  30 use CatalystX::GlobalContext qw( $c );
  31
  32 sub new {
  33     my $class  = shift;
  34     my $schema = 'phenome';
  35     my $self   = $class->SUPER::new(@_);
  36     return $self;
  37 }
  38
  39 sub define_object {
  40     my $self = shift;
  41     $self->set_dbh( CXGN::DB::Connection->new('phenome') );
  42     my %args      = $self->get_args();
  43     my $allele_id = $args{allele_id};
  44     unless ( !$allele_id || $allele_id =~ m /^\d+$/ ) {
  45         $self->get_page->message_page(
  46             "No allele exists for identifier $allele_id");
  47     }
  48     $self->set_object_id($allele_id);
  49     $self->set_object(
  50         CXGN::Phenome::Allele->new( $self->get_dbh, $self->get_object_id ) );
  51
  52     $self->set_primary_key("allele_id");
  53     $self->set_owners( $self->get_object()->get_owners() )
  54       ;    #instead of get_sp_person_id()
  55 }
  56
  57 # override store to check if an allele with the submitted symbol already exists for this locus
  58
  59 sub store {
  60     my $self      = shift;
  61     my $allele    = $self->get_object();
  62     my $allele_id = $self->get_object_id();
  63     $allele->set_is_default('f');
  64     my %args     = $self->get_args();
  65     my $action   = $args{action};
  66     my $locus_id = $args{locus_id};
  67
  68     my ($message) =
  69       $allele->exists_in_database( $args{allele_symbol}, $args{locus_id} );
  70     if ($message) {
  71         $self->get_page()->message_page($message);
  72         exit();
  73     }
  74     else {
  75         $self->send_allele_email();
  76         $self->SUPER::store(1);
  77     }
  78
  79     $allele_id = $allele->get_allele_id();
  80     $self->get_page()
  81       ->client_redirect("/phenome/allele.pl?allele_id=$allele_id");
  82
  83 }
  84
  85 sub delete {
  86     my $self = shift;
  87     my %args = $self->get_args();
  88     $self->check_modify_privileges();
  89
  90     my $locus;
  91     my $locus_name;
  92
  93     my $allele_symbol = $self->get_object()->get_allele_symbol();
  94     my $locus_id      = $self->get_object()->get_locus_id();
  95     if ($locus_id) {
  96         $locus = CXGN::Phenome::Locus->new( $self->get_dbh(), $locus_id );
  97         $locus_name = $locus->get_locus_name();
  98         $locus->remove_allele( $args{allele_id} );
  99         $self->send_allele_email('delete');
 100     }
 101
 102     $self->get_page()->header();
 103
 104     if ($locus) {
 105         print
 106 qq { Removed allele "$allele_symbol" association from locus "$locus_name". };
 107         print
 108 qq { <a href="/locus/$locus_id/view">back to locus</a> };
 109     }
 110
 111     $self->get_page()->footer();
 112
 113 }
 114
 115 =head2 delete_dialog
 116
 117  Usage:
 118  Desc:
 119  Ret:
 120  Args:
 121  Side Effects:
 122  Example:
 123 # $self->delete_dialog("Delete", "Object",
 124 #                            $self->get_primary_key(),
 125 #                            $id,
 126 #                            "<a href=\"".$self->get_script_name()."?".$self->get_primary_key()."=".$id."&amp;action=view\">Go back to detail page without deleting</a>");
 127
 128
 129 =cut
 130
 131 sub delete_dialog {
 132
 133     my $self = shift;
 134     $self->check_modify_privileges();
 135     my %args        = $self->get_args();
 136     my $title       = shift;
 137     my $object_name = shift;
 138     my $field_name  = shift;
 139     my $object_id   = shift;
 140
 141     my $back_link =
 142         "<a href=\""
 143       . $self->get_script_name() . "?"
 144       . $self->get_primary_key() . "="
 145       . $object_id
 146       . "&amp;action=view\">Go back to allele page without deleting</a>";
 147
 148     $self->get_page()->header();
 149
 150     page_title_html("$title");
 151     print qq {
 152         <form>
 153         Delete allele (id=$object_id)?
 154         <input type="hidden" name="action" value="delete" />
 155         <input type="hidden" name="$field_name" value="$object_id" />
 156
 157         <input type="submit" value="Delete" />
 158         </form>
 159
 160         $back_link
 161
 162     };
 163
 164     $self->get_page()->footer();
 165 }
 166
 167 sub display_page {
 168     my $self = shift;
 169     my %args = $self->get_args();
 170
 171     my $allele        = $self->get_object();
 172     my $allele_id     = $self->get_object_id();
 173     my $allele_symbol = $allele->get_allele_symbol();
 174     my $locus_id      = $allele->get_locus_id();
 175     my $locus_name    = $allele->get_locus_name();
 176
 177     my $stock_ids      = $allele->get_stock_ids();
 178     my $default_allele = $allele->get_is_default();
 179
 180     ###import js libraries
 181     $self->get_page->jsan_use("CXGN.Phenome.Tools");
 182     $self->get_page->jsan_use("CXGN.Phenome.Locus");
 183     $self->get_page->jsan_use("MochiKit.DOM");
 184     $self->get_page->jsan_use("Prototype");
 185     $self->get_page->jsan_use("jquery");
 186     $self->get_page->jsan_use("thickbox");
 187     ###
 188
 189     my $page = "../phenome/allele.pl?allele_id=$allele_id";
 190     my $action = $args{action} || "";
 191     if ( $default_allele eq 't'
 192         || ( !$allele_id & ( $action eq 'view' || $action eq 'edit' ) ) )
 193     {
 194         $self->get_page->message_page("No allele exists for this identifier");
 195     }
 196
 197     if ( $args{locus_id} ) {
 198         $locus_id = $args{locus_id};
 199         $locus_name =
 200           CXGN::Phenome::Locus->new( $self->get_dbh(), $locus_id )
 201           ->get_locus_name();
 202     }
 203     $self->get_page->header("SGN allele $allele_symbol of locus $locus_name");
 204     print page_title_html("Allele:\t'$allele_symbol'\n");
 205
 206     my $edit_links = $self->get_edit_links();
 207
 208     my $allele_html =
 209       $edit_links . "<br />" . $self->get_form()->as_table_string() . "<br />";
 210
 211     my $allele_synonym_link =
 212       "allele_synonym.pl?allele_id=$allele_id&amp;action=new";
 213     my $allele_synonyms = "";
 214     foreach my $a_synonym ( $allele->get_allele_aliases() ) {
 215         $allele_synonyms .= $a_synonym->get_allele_alias() . "  ";
 216     }
 217
 218     $allele_html .= qq|<br><b> Allele synonyms: </b>$allele_synonyms|;
 219     unless ( $self->get_action =~ /new/ ) {
 220         $allele_html .=
 221           qq|<a href="$allele_synonym_link"> [Add/remove] </a> <br><br>|;
 222     }
 223
 224     ###history
 225     my $login_user      = $self->get_user();
 226     my $login_user_id   = $login_user->get_sp_person_id();
 227     my $login_user_type = $login_user->get_user_type();
 228     my $object_owner    = $allele->get_sp_person_id();
 229     my @locus_owners    = $allele->get_locus()->get_owners();
 230     if (   $login_user_type eq 'curator'
 231         || $login_user_id == $object_owner
 232         || ( grep { /^$login_user_id$/ } @locus_owners ) )
 233     {
 234         my $history_data = $self->print_allele_history() || "";
 235         $allele_html .= $history_data;
 236     }
 237     print info_section_html(
 238         title    => 'Allele details',
 239         contents => $allele_html,
 240     );
 241     my $stocks_html = "<TABLE>";
 242     my %imageHoA
 243       ; # hash of image arrays. Keys are stock_ids, values are arrays of image_ids
 244     my %stockHash;
 245     my %imageHash;
 246     my @no_image = ();
 247
 248     my $schema = $c->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 249     foreach my $stock_id (@$stock_ids) {
 250         my $stock = CXGN::Chado::Stock->new( $schema, $stock_id );
 251         my $stock_name = $stock->get_name();
 252         $stockHash{$stock_id} = $stock_name;
 253
 254         my @images = map SGN::Image->new( $self->get_dbh, $_->[0], $c ), $stock->get_image_ids();
 255         foreach my $image (@images) {
 256             my $image_id    = $image->get_image_id();
 257             my $img_src_tag = $image->get_img_src_tag("thumbnail");
 258             $imageHash{$image_id} = $img_src_tag;
 259             push @{ $imageHoA{$stock_id} }, $image_id;
 260         }
 261
 262         #if there are no associated images with this stock:
 263         if ( !@images ) { push @no_image, $stock_id; }
 264     }
 265     for my $stock_id (
 266         sort { @{ $imageHoA{$b} } <=> @{ $imageHoA{$a} } }
 267         keys %imageHoA
 268       )
 269     {
 270         my $stock_name = $stockHash{$stock_id};
 271         $stocks_html .=
 272 qq|<TR valign="top"><TD><a href="/stock/$stock_id/view">$stock_name </a></TD>|;
 273
 274         foreach my $image_id ( @{ $imageHoA{$stock_id} } ) {
 275             my $image_src_tag = $imageHash{$image_id};
 276             $stocks_html .=
 277 qq |<TD><a href="../image/index.pl?image_id=$image_id">$image_src_tag</a></TD>|;
 278         }
 279         $stocks_html .= "</TR>";
 280     }
 281     if ( !@$stock_ids ) { $stocks_html = undef; }
 282     else                 { $stocks_html .= "</TABLE>"; }
 283
 284     foreach my $stock_id (@no_image) {
 285         my $stock_name = $stockHash{$stock_id};
 286         $stocks_html .=
 287 qq|<a href="/stock/$stock_id/view">$stock_name </a>|;
 288     }
 289
 290     my $stock_subtitle = "";
 291     if (
 292         $allele_symbol
 293         && (   $login_user_type eq 'curator'
 294             || $login_user_type eq 'submitter'
 295             || $login_user_type eq 'sequencer' )
 296       )
 297     {
 298
 299         $stock_subtitle .=
 300 qq| <a href="javascript:Tools.toggleContent('associateStockForm', 'allele_accessions')">[Associate accession]</a> |;
 301
 302         $stocks_html .= $self->associate_stock;
 303     }
 304     else {
 305         $stock_subtitle .=
 306           qq|<span class= "ghosted">[Associate accession]</span> |;
 307     }
 308
 309     print info_section_html(
 310         title       => 'Associated accessions',
 311         subtitle    => $stock_subtitle,
 312         contents    => $stocks_html,
 313         id          => "allele_accessions",
 314         collapsible => 1,
 315         collapsed   => 1,
 316     );
 317
 318     ######
 319
 320     my ( $pubmed_links, $pub_count, $genbank, $gb_count ) =
 321       $self->get_dbxref_info();
 322
 323     my $new_gb =
 324 qq|<a href="/chado/add_feature.pl?type=allele&amp;type_id=$allele_id&amp;&amp;refering_page=$page&amp;action=new">[Associate new genbank sequence]</a>|
 325       if $allele_symbol;
 326
 327     print info_section_html(
 328         title       => "Sequence annotations ($gb_count)",
 329         subtitle    => $new_gb,
 330         contents    => $genbank,
 331         collapsible => 1,
 332     );
 333
 334     my $new_pub_link .=
 335 qq|<a href="../chado/add_publication.pl?type=allele&amp;type_id=$allele_id&amp;&amp;refering_page=$page&amp;action=new">[associate new publication]</a>|
 336       if $allele_symbol;
 337
 338     print info_section_html(
 339         title       => 'Literature annotation',
 340         subtitle    => $new_pub_link,
 341         contents    => $pubmed_links,
 342         collapsible => 1,
 343     );
 344
 345 ####add page comments
 346     if ($allele_symbol) {
 347         my $page_comment_obj =
 348           CXGN::People::PageComment->new( $self->get_dbh(), "allele",
 349             $allele_id, $self->get_page()->{request}->uri()."?".$self->get_page()->{request}->args() );
 350         print $page_comment_obj->get_html();
 351     }
 352
 353     $self->get_page()->footer();
 354 }
 355
 356 sub generate_form {
 357     my $self = shift;
 358     $self->init_form();
 359     my $allele = $self->get_object();
 360
 361     my %args           = $self->get_args();
 362     my $mode_names_ref = [ 'recessive', 'partially dominant', 'dominant' ];
 363     my $locus_name     = $allele->get_locus_name();
 364     my $locus_id       = $allele->get_locus_id();
 365     if ( $self->get_action =~ /new/ ) {
 366         $locus_id = $args{locus_id};
 367         my $locus_obj =
 368           CXGN::Phenome::Locus->new( $self->get_dbh(), $locus_id );
 369         $locus_name = $locus_obj->get_locus_name();
 370     }
 371     $locus_name =
 372       qq|<a href= "/locus/$locus_id/view">$locus_name</a>|;
 373
 374     $self->get_form()->add_label(
 375         display_name => "Locus name",
 376         field_name   => "locus_name",
 377         contents     => $locus_name,
 378     );
 379
 380     $self->get_form()->add_field(
 381         display_name => "Allele symbol ",
 382         field_name   => "allele_symbol",
 383         object       => $allele,
 384         getter       => "get_allele_symbol",
 385         setter       => "set_allele_symbol",
 386         validate     => 'allele_symbol',
 387     );
 388     $self->get_form()->add_field(
 389         display_name => "Allele name ",
 390         field_name   => "allele_name",
 391         object       => $allele,
 392         getter       => "get_allele_name",
 393         setter       => "set_allele_name",
 394         validate     => 'string',
 395     );
 396
 397     $self->get_form()->add_select(
 398         display_name       => "Mode of inheritance ",
 399         field_name         => "mode_of_inheritance",
 400         object             => $allele,
 401         contents           => $args{mode_of_inheritance},
 402         getter             => "get_mode_of_inheritance",
 403         setter             => "set_mode_of_inheritance",
 404         select_list_ref    => $mode_names_ref,
 405         select_id_list_ref => $mode_names_ref,
 406     );
 407
 408     $self->get_form()->add_textarea(
 409         display_name => "Phenotype ",
 410         field_name   => "allele_phenotype",
 411         object       => $allele,
 412         getter       => "get_allele_phenotype",
 413         setter       => "set_allele_phenotype",
 414         columns      => 40,
 415         rows         => => 4,
 416     );
 417
 418     $self->get_form()->add_textarea(
 419         display_name => "Sequence/mutation ",
 420         field_name   => "allele_sequence",
 421         object       => $allele,
 422         getter       => "get_sequence",
 423         setter       => "set_sequence",
 424         columns      => 40,
 425         rows         => => 4,
 426     );
 427
 428     $self->get_form()->add_hidden(
 429         field_name => "allele_id",
 430         contents   => $args{allele_id},
 431         object     => $allele,
 432         getter     => "get_allele_id",
 433         setter     => "set_allele_id"
 434     );
 435
 436     $self->get_form()->add_hidden(
 437         field_name => "action",
 438         contents   => "store",
 439     );
 440
 441     $self->get_form()->add_hidden(
 442         field_name => "sp_person_id",
 443         contents   => $self->get_user()->get_sp_person_id(),
 444         object     => $allele,
 445         setter     => "set_sp_person_id",
 446
 447     );
 448
 449     $self->get_form()->add_hidden(
 450         field_name => "updated_by",
 451         contents   => $self->get_user()->get_sp_person_id(),
 452         object     => $allele,
 453         setter     => "set_updated_by",
 454     );
 455
 456     $self->get_form()->add_hidden(
 457         field_name => "locus_id",
 458         contents   => $args{locus_id},
 459         object     => $allele,
 460         getter     => "get_locus_id",
 461         setter     => "set_locus_id"
 462     );
 463
 464     if ( $self->get_action =~ /view|edit/ ) {
 465
 466         $self->get_form->from_database();
 467     }
 468     elsif ( $self->get_action =~ /store/ ) {
 469         $self->get_form->from_request( $self->get_args() );
 470     }
 471
 472 }
 473
 474 #########################################################
 475 #
 476 sub get_dbxref_info {
 477     my $self   = shift;
 478     my $allele = $self->get_object();
 479     my %dbs    = $allele->get_dbxref_lists()
 480       ;    #hash of arrays. keys=dbname values= dbxref objects
 481
 482     my ( $pubs, $genbank );
 483
 484     my $abs_count = 0;
 485     foreach ( @{ $dbs{'PMID'} } ) {
 486         $abs_count++;
 487         my ( $detail, $abstract ) =
 488           CXGN::Chado::Publication::get_pub_info( $_->[0], 'PMID' )
 489           if $_->[1] eq '0';
 490         $pubs .= "<div>" . $detail . html_optional_show(
 491             "abstract$abs_count",
 492             'Show/hide abstract',
 493             $abstract,
 494             0,                        #< do not show by default
 495             'abstract_optional_show', #< don't use the default button-like style
 496         ) . "</div>";
 497     }
 498     foreach ( @{ $dbs{'SGN_ref'} } ) {
 499         $abs_count++;
 500         my ( $det, $abs ) =
 501           CXGN::Chado::Publication::get_pub_info( $_->[0], 'SGN_ref' )
 502           if $_->[1] eq '0';
 503         $pubs .= "<div>" . $det . html_optional_show(
 504             "abstract$abs_count",
 505             'Show/hide abstract',
 506             $abs,
 507             0,                        #< do not show by default
 508             'abstract_optional_show', #< don't use the default button-like style
 509         ) . "</div>";
 510     }
 511
 512     my $gb_count = 0;
 513     foreach ( @{ $dbs{'DB:GenBank_GI'} } ) {
 514         if ( $_->[1] eq '0' ) {
 515             $gb_count++;
 516             my $url = $_->[0]->get_urlprefix() . $_->[0]->get_url();
 517             my $gb_accession =
 518               $self->CXGN::Chado::Feature::get_feature_name_by_gi(
 519                 $_->[0]->get_accession() );
 520             my $description = $_->[0]->get_description();
 521             $genbank .=
 522 qq|<a href="$url$gb_accession" target="blank">$gb_accession</a> $description<br />|;
 523         }
 524     }
 525
 526     return ( $pubs, $abs_count, $genbank, $gb_count );
 527 }
 528
 529 ###########
 530
 531 sub get_edit_links {
 532     my $self      = shift;
 533     my $form_name = shift;
 534     return
 535         $self->get_new_link_html($form_name) . " "
 536       . $self->get_edit_link_html($form_name) . " "
 537       . $self->get_delete_link_html($form_name);
 538
 539 }
 540
 541 sub get_new_link_html {
 542     my $self      = shift;
 543     my $form_name = shift;
 544
 545     my $script_name = $self->get_script_name();
 546     my $primary_key = $self->get_primary_key();
 547     my $object_id   = $self->get_object_id();
 548     my $locus_id    = $self->get_object->get_locus_id();
 549
 550     my $new_link =
 551 qq { <a href="$script_name?action=new&amp;locus_id=$locus_id&amp;form=$form_name">[New]</a> };
 552     if ( $self->get_action() eq "edit" ) {
 553         $new_link = qq { <span class="ghosted">[New]</span> };
 554     }
 555     if ( $self->get_action() eq "new" ) {
 556         $new_link = qq { <a onClick="history.go(-1)">[Cancel]</a> };
 557     }
 558     return $new_link;
 559 }
 560
 561 sub print_allele_history {
 562
 563     my $self   = shift;
 564     my $allele = $self->get_object();
 565     my @history;
 566     my $history_data;
 567     my $print_history;
 568     my @history_objs = $allele->show_history(); #array of allele_history objects
 569
 570     foreach my $h (@history_objs) {
 571
 572         my $created_date = $h->get_create_date();
 573         $created_date = substr $created_date, 0, 10;
 574
 575         my $history_id    = $h->{allele_history_id};
 576         my $updated_by_id = $h->{updated_by};
 577         my $updated =
 578           CXGN::People::Person->new( $self->get_dbh(), $updated_by_id );
 579         my $u_first_name = $updated->get_first_name();
 580         my $u_last_name  = $updated->get_last_name();
 581         my $up_person_link =
 582 qq |<a href="/solpeople/personal-info.pl?sp_person_id=$updated_by_id">$u_first_name $u_last_name</a> ($created_date)|;
 583
 584         push @history,
 585           [
 586             map { $_ } (
 587                 $h->get_allele_symbol,    $h->get_allele_name,
 588                 $h->get_allele_phenotype, $h->get_sequence,
 589                 $up_person_link,
 590             )
 591           ];
 592     }
 593
 594     if (@history) {
 595
 596         $history_data .= columnar_table_html(
 597             headings =>
 598               [ 'Symbol', 'Name', 'Phenotype', 'Sequence', 'Updated by', ],
 599             data         => \@history,
 600             __alt_freq   => 2,
 601             __alt_width  => 1,
 602             __alt_offset => 3,
 603         );
 604         $print_history = html_optional_show(
 605             'allele_history',
 606             'Show allele history',
 607             qq|<div class="minorbox">$history_data</div> |,
 608         );
 609     }
 610
 611     return $print_history;
 612 }    #print_allele_history
 613
 614 sub associate_stock {
 615     my $self         = shift;
 616     my $allele_id    = $self->get_object_id();
 617     my $sp_person_id = $self->get_user->get_sp_person_id();
 618     my $locus_id     = $self->get_object()->get_locus_id();
 619
 620     my $associate_html = qq^
 621
 622 <div id="associateStockForm" style="display: none">
 623     Accession name:
 624     <input type="text"
 625            style="width: 50%"
 626            id="a_name"
 627            onkeyup="Locus.getStocks(this.value);">
 628     <input type="button"
 629            id="associate_stock_button"
 630            value="associate accession"
 631            disabled="true"
 632            onclick="Locus.associateAllele('$sp_person_id', '$allele_id');this.disabled=true;">
 633     <select id="stock_select"
 634             style="width: 100%"
 635             onchange="Tools.enableButton('associate_stock_button');"
 636             size=10>
 637        </select>
 638 </div>
 639 ^;
 640
 641     return $associate_html;
 642 }
 643
 644 sub send_allele_email {
 645     my $self        = shift;
 646     my $action      = shift;
 647     my $allele_id   = $self->get_object()->get_allele_id();
 648     my $allele_name = $self->get_object()->get_allele_name();
 649     my %args        = $self->get_args();
 650     my $locus_id    = $args{locus_id};
 651
 652     my $subject = "[New allele details stored] allele $allele_id";
 653     my $username =
 654         $self->get_user()->get_first_name() . " "
 655       . $self->get_user()->get_last_name();
 656     my $sp_person_id = $self->get_user()->get_sp_person_id();
 657
 658     my $locus_link =
 659 qq |http://solgenomics.net/locus/$locus_id/view|;
 660     my $user_link =
 661 qq |http://solgenomics.net/solpeople/personal-info.pl?sp_person_id=$sp_person_id|;
 662     my $usermail = $self->get_user()->get_private_email();
 663     my $fdbk_body;
 664     if ( $action eq 'delete' ) {
 665         $fdbk_body =
 666 "$username ($user_link) has obsoletes allele $allele_id ($locus_link) \n$usermail";
 667     }
 668     elsif ($allele_id) {
 669         $fdbk_body =
 670 "$username ($user_link) has submitted data for allele $allele_name ($locus_link) \n$usermail";
 671     }
 672     else {
 673         $fdbk_body =
 674 "$username ($user_link) has submitted a new  allele $allele_name for locus $locus_link \n$usermail";
 675     }
 676     CXGN::Contact::send_email( $subject, $fdbk_body,
 677         'sgn-db-curation@sgn.cornell.edu' );
 678     CXGN::Feed::update_feed( $subject, $fdbk_body );
 679 }