cgi-bin/chado/add_feature.pl

   1 use strict;
   2
   3 my $add_feature_page = CXGN::Chado::AddFeaturePage->new();
   4
   5 package CXGN::Chado::AddFeaturePage;
   6
   7
   8 use CXGN::Page;
   9 use CXGN::Page::FormattingHelpers qw / info_section_html page_title_html html_optional_show /;
  10 use CXGN::Page::Form::EditableCheckbox;
  11 use CXGN::Chado::Feature;
  12
  13 use CXGN::Phenome::Locus;
  14 use CXGN::Phenome::Allele;
  15
  16 use CXGN::Tools::FeatureFetch;
  17 use CXGN::Tools::Pubmed;
  18 use CXGN::Chado::Organism;
  19 use Bio::Chado::Schema;
  20
  21 use CXGN::Chado::Publication;
  22 use CXGN::Tools::Text qw / sanitize_string /;
  23 use base qw / CXGN::Page::Form::SimpleFormPage /;
  24
  25
  26 sub new {
  27     my $class = shift;
  28     my $self = $class->SUPER::new(@_);
  29     $self->set_script_name("add_feature.pl");
  30
  31     #my $schema= CXGN::DB::DBICFactory->open_schema( 'Bio::Chado::Schema') ;
  32
  33     # $self->set_schema($schema);
  34     return $self;
  35 }
  36
  37
  38
  39 sub define_object {
  40     my $self = shift;
  41
  42     # call set_object_id, set_object and set_primary_key here
  43     # with the appropriate parameters.
  44     #
  45     my %args = $self->get_args();
  46     $self->set_object_id($args{feature_id});
  47     $self->set_object(CXGN::Chado::Feature->new( $self->get_dbh(), $self->get_object_id() )
  48                       );
  49     $self->set_primary_key("feature_id");
  50     $self->set_owners();
  51 }
  52
  53 sub store {
  54     my $self = shift;
  55
  56     my $feature = $self->get_object();
  57     my $sp_person_id=$self->get_user()->get_sp_person_id();
  58
  59     my %args = $self->get_args();
  60
  61     my $action=$args{action};
  62     my $refering_page=$args{refering_page};
  63     my $type= $args{type};  #locus or allele or...?
  64     my $type_id = $args{type_id}; #the database id of the refering object (locus..)
  65     my $GBaccession= sanitize_string($args{accession});
  66     my $checkbox_value = $args{publications_checkbox};
  67     my $script_name= $self->get_script_name();
  68
  69     my ($locus, $allele);
  70
  71     #retrieve the locus or allele objects based on their type_id
  72     if ($type eq 'locus') {  $locus= CXGN::Phenome::Locus->new($self->get_dbh(), $type_id); }
  73     elsif ($type eq 'allele') { $allele= CXGN::Phenome::Allele->new($self->get_dbh(), $type_id); }
  74     my $dbxref_id;
  75     my $feature_id;
  76
  77     $feature->set_name($GBaccession);
  78
  79     my $existing_feature = $feature->feature_exists();
  80     if ($existing_feature) {
  81         #if the feature is already stored in dbxref, we need its dbxref_id for storing it in the feature_dbxref linking table
  82         $feature=CXGN::Chado::Feature->new($self->get_dbh(), $existing_feature);
  83         $dbxref_id= $feature->get_dbxref_id();
  84     }
  85
  86     #If the feature exists then fetch the dbxref object with that dbxref_id
  87     my $dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $dbxref_id);
  88
  89     my ($associated_feature, $obsolete);
  90     if ($type eq 'locus') {
  91         $associated_feature = $locus->get_locus_dbxref($dbxref)->get_object_dbxref_id();
  92         $obsolete = $locus->get_locus_dbxref($dbxref)->get_obsolete();
  93     }
  94     elsif ($type eq 'allele') {
  95         $associated_feature= $allele->get_allele_dbxref($dbxref)->get_allele_dbxref_id();
  96         $obsolete = $allele->get_allele_dbxref($dbxref)->get_obsolete();
  97     }
  98     #Fetch the feature from genbank:
  99     my $db_name = 'DB:GenBank_GI';
 100     $feature->set_db_name($db_name);
 101     $feature->set_name($GBaccession);
 102     CXGN::Tools::FeatureFetch->new($feature);
 103
 104     #the feature exists in our database but is not associated (checked in confirm_store) with the sequence. Associate the two and then exit the function.
 105     if ($dbxref_id ) {
 106         if ($type eq 'locus') {
 107             $locus->add_locus_dbxref($dbxref, $associated_feature, $sp_person_id);
 108         }
 109         elsif ($type eq 'allele') {
 110             $allele->add_allele_dbxref($dbxref, $associated_feature, $sp_person_id);
 111         }
 112         #
 113         #only store the publications if the user specified to do so
 114         if($checkbox_value eq 'on'){
 115             $self->store_publications($feature);
 116             #the pubmed_ids aren't stored in the database for features so we need to re-fetch them. There may be a better way to do this.
 117             #CXGN::Tools::FeatureFetch->new($feature);
 118             #if ($message) { $self->get_page->message_page($message); }
 119             #else { $self->store_publications($feature); }
 120         }
 121     }else { # need to fetch the feature and give it a new dbxref_id
 122
 123         my $mol_type= $feature->get_molecule_type();
 124         #if (!$mol_type) {
 125         $feature->set_molecule_type('DNA') ;  #this default value has to be resolved in a better way
 126         #molecule type in entrez XML does not always follow SO names.
 127
 128         #only store the publications if the user specified to do so
 129         if($checkbox_value eq 'on'){
 130             $self->store_publications($feature);
 131         }
 132         $self->SUPER::store(1); #this gives the feature a  dbxref id, and stores it in feature, and featre_dbxref
 133
 134         #instantiate a new dbxref object
 135         $dbxref_id=$feature->get_dbxref_id();
 136         $dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $dbxref_id);
 137
 138         #store the new locus_dbxref..
 139         if ($type eq 'locus') { $locus->add_locus_dbxref($dbxref, undef, $sp_person_id); }
 140         elsif ($type eq 'allele') { $allele->add_allele_dbxref($dbxref, undef, $sp_person_id); }
 141
 142     }
 143
 144     $self->send_feature_email('store');
 145     $self->get_page()->client_redirect("$script_name?type=$type&amp;type_id=$type_id&amp;refering_page=$refering_page&amp;action=new");
 146 }
 147
 148 sub delete_dialog {
 149     my $self = shift;
 150     my %args = $self->get_args();
 151     $self->check_modify_privileges();
 152
 153     my $title = shift;
 154     my $object_name = shift;
 155     my $field_name = shift;
 156     my $object_id = shift;
 157
 158
 159     my $type = $args{type};
 160     my $type_id= $args{type_id}; #the id of the object we want to associate to the feature
 161
 162     my $object_dbxref_id= undef;
 163     my ($locus,$locus_name, $allele, $allele_name);
 164
 165     if ($args{object_dbxref_id}) {
 166         if ($type eq 'locus') {
 167             $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $type_id);
 168             $locus_name = $locus->get_locus_name();
 169             $object_name=$locus_name;
 170             print STDERR "!!!*$locus_name $object_name\n";
 171         }elsif ($type eq 'allele') {
 172             $allele = CXGN::Phenome::Allele->new($self->get_dbh(), $type_id);
 173             $allele_name = $allele->get_allele_name();
 174             $object_name=$allele_name;
 175         }
 176         $object_dbxref_id= $args{object_dbxref_id};
 177     }
 178
 179     my $back_link= qq |<a href="javascript:history.back(1)">Go back without deleting</a> |;
 180
 181     $self->get_page()->header();
 182
 183
 184     page_title_html();
 185     print qq {
 186         <form>
 187             Delete the sequence association with $type ($object_name)?
 188             <input type="hidden" name="action" value="delete" />
 189             <input type="hidden" name="$field_name" value="$object_id" />
 190             <input type="hidden" name="type" value="$type" />
 191             <input type="hidden" name="type_id" value="$type_id" />
 192             <input type="hidden" name="object_dbxref_id" value="$object_dbxref_id" />
 193             <input type="hidden" name="refering_page" value="$args{refering_page}" />
 194             <input type="submit" value="Delete" />
 195             </form>
 196
 197             $back_link
 198         };
 199
 200     $self->get_page()->footer();
 201  #
 202 }
 203
 204
 205 sub delete {
 206     my $self  = shift;
 207     $self->check_modify_privileges();
 208     my $script_name= $self->get_script_name();
 209     my %args= $self->get_args();
 210     my $type= $args{type};
 211     my $type_id= $args{type_id};
 212
 213     my $refering_page=$args{refering_page};
 214
 215     my $feature = $self->get_object();
 216
 217     if ($type eq 'locus') {
 218         my $locus_dbxref_obj=CXGN::Phenome::LocusDbxref->new($self->get_dbh, $args{object_dbxref_id});
 219         $locus_dbxref_obj->obsolete();
 220     }elsif ($type eq 'allele') {
 221         my $allele_dbxref_obj=CXGN::Phenome::AlleleDbxref->new($self->get_dbh, $args{object_dbxref_id});
 222         $allele_dbxref_obj->delete();
 223     }else { print qq | <h3> What are you trying to delete here? </h3>| ; exit();}
 224
 225     $self->send_feature_email('delete');
 226     $self->get_page()->client_redirect("$script_name?type=$type&amp;type_id=$type_id&amp;refering_page=$refering_page&amp;action=new");
 227 }
 228
 229
 230 sub generate_form {
 231     my $self = shift;
 232
 233     my %args = $self->get_args();
 234     my $feature = $self->get_object();
 235     my $feature_id = $self->get_object_id();
 236
 237     $self->init_form();
 238
 239     # generate the form with the appropriate values filled in.
 240     # if we view, then take the data straight out of the database
 241     # if we edit, take data from database and override with what's
 242     # in the submitted form parameters.
 243     # if we store, only take the form parameters into account.
 244     # for new, we don't do anything - we present an empty form.
 245     #
 246
 247     # add form elements
 248     #
 249     $self->get_form()->add_field(display_name=>"Enter a Genbank accession: ",
 250                                  field_name=>"accession",
 251                                  length=>20,
 252                                  object=>$feature,
 253                                  getter=>"get_name",
 254                                  setter=>"set_name",
 255                                  validate=>"token"
 256                                  );
 257
 258
 259     $self->get_form()->add_hidden( field_name=>"action", contents=>"confirm_store" );
 260     $self->get_form()->add_hidden( field_name=>"feature_id", contents=>$feature_id );
 261
 262     $self->get_form()->add_hidden( field_name=>"type_id",
 263                                    contents=>$args{type_id}  );
 264
 265     $self->get_form()->add_hidden( field_name=>"type",
 266                                    contents=>$args{type}  );
 267
 268     $self->get_form()->add_hidden( field_name=>"refering_page",
 269                                    contents=>$args{refering_page}  );
 270
 271
 272     if ($self->get_action()=~/store/i) {
 273         $self->get_form()->from_request(%args);
 274     }
 275 }
 276
 277 =head2 display_page
 278
 279  Usage:
 280  Desc: This is the function that actually displays the web page with the included form
 281  Ret:
 282  Args:
 283  Side Effects:
 284  Example:
 285
 286 =cut
 287
 288 sub display_page {
 289     my $self = shift;
 290     my %args = $self->get_args();
 291
 292     # generate an appropriate edit link
 293     #
 294     my $script_name = $self->get_script_name();
 295
 296
 297     my @features = ();
 298     my @obsoleted= ();
 299     my ($locus, $allele, @dbxref_objs, $object_dbxref_id, $obsolete, $name_dbxref_id); #add vars here if you want this script to work with other object types..
 300
 301     # render the form
 302     $self->get_page()->header();
 303
 304     print page_title_html( qq { SGN feature upload page } );
 305
 306     print qq { <b> Features list</b> };
 307
 308     if ($args{type} eq 'locus') {
 309         $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $args{type_id});
 310         @dbxref_objs= $locus->get_dbxrefs(); #array of dbxref objects
 311         print "for locus '".$locus->get_locus_name()."'<br /><br />\n";
 312
 313     }elsif ($args{type} eq 'allele') {
 314         $allele = CXGN::Phenome::Allele->new($self->get_dbh(), $args{type_id});
 315         @dbxref_objs=$allele->get_all_allele_dbxrefs(); #array of dbxref objects
 316         print "for allele '".$allele->get_allele_name()."'<br /><br />\n";
 317     }
 318
 319     foreach my $dbxref (@dbxref_objs) {
 320
 321         my $feature= $dbxref->get_feature();
 322         my $GBaccession= $feature->get_name();
 323         my $feature_id = $feature->get_feature_id();
 324         my $accession= $dbxref->get_accession();
 325         my $description = $dbxref->get_description();
 326
 327         if ($args{type} eq 'locus') {
 328             $object_dbxref_id= $locus->get_locus_dbxref($dbxref)->get_object_dbxref_id();
 329             $obsolete= $locus->get_locus_dbxref($dbxref)->get_obsolete();
 330         }elsif  ($args{type} eq 'allele') {
 331             $object_dbxref_id= $allele->get_allele_dbxref($dbxref)->get_allele_dbxref_id();
 332             $obsolete= $allele->get_allele_dbxref($dbxref)->get_obsolete();
 333         }
 334
 335         if ($obsolete eq 'f') {
 336             my $genbank_link= "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Retrieve&db=nuccore&list_uids=$accession";
 337             if ($feature_id && $object_dbxref_id) {print "<a href= $genbank_link target=blank>$GBaccession </a>" . $description . qq { \n <a href="add_feature.pl?feature_id=$feature_id&amp;type=$args{type}&amp;type_id=$args{type_id}&amp;object_dbxref_id=$object_dbxref_id&amp;action=confirm_delete&amp;refering_page=$args{refering_page}">[Remove]</a> <br />\n }; }
 338         }elsif ($feature_id)  {
 339             push @obsoleted, $feature ; #an array of obsoletes feature objects
 340         }
 341     }
 342
 343     if (@obsoleted) { print_obsoleted(@obsoleted) ; }
 344
 345     print qq { <br /><br /><b>Associate a sequence with this $args{type}</b>: };
 346     print qq { <center> };
 347     $self->get_form()->as_table();
 348     print qq { </center> };
 349
 350     if ($args{refering_page}) { print "<a href=\"$args{refering_page}\">[Go back]</a><br /><br />\n"; }
 351     $self->get_page()->footer();
 352 }
 353
 354
 355 sub print_obsoleted {
 356     my @features=@_;
 357     my $obsoleted_features;
 358     foreach my $feature (@features) {
 359         my $GBaccession = $feature->get_name();
 360         my $description = $feature->get_description();
 361         my $genbank_link= "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Retrieve&db=nuccore&list_uids=$GBaccession";
 362         $obsoleted_features .=  qq |<a href= $genbank_link target=blank> $GBaccession - $description </a>  <br />\n |;
 363     }
 364
 365
 366
 367     my $print_obsoleted= "<br>" .
 368         html_optional_show('obsoleted_features',
 369                            'Show obsolete',
 370                            qq|<div class="minorbox">$obsoleted_features</div> |,
 371                            );
 372
 373     print $print_obsoleted;
 374     #return $print_obsoleted;
 375 }
 376
 377
 378
 379 sub confirm_store {
 380     my $self=shift;
 381     my %args=$self->get_args();
 382     my $refering_page=$args{refering_page};
 383     my $type= $args{type};  #locus or allele or...?
 384     my $type_id = $args{type_id}; #the database id of the refering object (locus..)
 385     my $GBaccession= sanitize_string($args{accession});
 386     my $feature= $self->get_object();
 387
 388     if ($GBaccession =~ m/^[a-z]/i) { #the accession submitted looks like a GenBank accession
 389         $feature->set_name($GBaccession);
 390         print STDERR "****add_feature.pl is setting feature name $GBaccession...\n\n";
 391     }elsif ($GBaccession=~ m/^\d/) { #the user submitted an accession that looks like a GenBank GI number!
 392         $self->get_page->message_page("Please type a valid genBank accession !!");
 393         print STDERR "^^^^add_feature.pl found an accession that looks like a gi number...\n\n";
 394     }
 395
 396
 397     #$feature->set_name($GBaccession);
 398     my $feature_id = $feature->get_feature_id();
 399     my $dbxref_id = $feature->get_dbxref_id();
 400
 401 ############
 402     #my $dbxref_id=undef;
 403
 404     $self->get_page()->header();
 405
 406     #need to check if the feature is already in the database and associated with the object (locus..)
 407     my $existing_feature= $feature->feature_exists($feature->set_name($GBaccession) );
 408     my ($locus, $allele);
 409     if ($type eq 'locus') { $locus= CXGN::Phenome::Locus->new($self->get_dbh(), $args{type_id}); }
 410     elsif ($type eq 'allele') {  $allele=CXGN::Phenome::Allele->new($self->get_dbh(), $args{type_id}); }
 411
 412     if ($existing_feature) {
 413
 414         #this feature exists, now we need to check if it's associated with the refering object
 415         $feature=CXGN::Chado::Feature->new($self->get_dbh(), $existing_feature);
 416         my @temp_pubmeds = $feature->get_pubmed_ids();
 417         $dbxref_id= $feature->get_dbxref_id();
 418
 419         ##dbxref object...
 420         my $dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $dbxref_id);
 421         my ($associated_feature, $obsolete);
 422         if ($type eq 'locus') {
 423             $associated_feature= $locus->get_locus_dbxref($dbxref)->get_object_dbxref_id();
 424             $obsolete = $locus->get_locus_dbxref($dbxref)->get_obsolete();
 425         }elsif ($type eq 'allele' ) {
 426             $associated_feature= $allele->get_allele_dbxref($dbxref)->get_allele_dbxref_id();
 427             $obsolete = $allele->get_allele_dbxref($dbxref)->get_obsolete();
 428         }
 429         print STDERR "$type _ dbxref obsolete = '$obsolete' !!!!!\n";
 430         if  ($associated_feature && $obsolete eq 'f') {
 431             print  "<h3>Sequence '$GBaccession' is already associated with $args{type}  $args{type_id} </h3>";
 432             print qq { <a href="javascript:history.back(1)">back to features</a> };
 433             $self->get_page()->footer();
 434
 435         }else{  ##the feature exists but not associated with the object
 436             print STDERR "*add_feature.pl: confirm_store...calling print_confirm_form (feature exists but not associated)\n";
 437
 438             $self->print_confirm_form();
 439
 440         }
 441     } else { # the feature doesn't exist in our database
 442         print STDERR "*add_feature.pl: confirm_store...calling print_confirm_form (feature does not exist in db)\n";
 443
 444         $self->print_confirm_form();
 445
 446     }
 447
 448 }
 449
 450
 451 =head2 print_confirm_form
 452
 453  Usage:
 454  Desc:
 455  Ret:
 456  Args:
 457  Side Effects:
 458  Example:
 459
 460 =cut
 461
 462 sub print_confirm_form {
 463     my $self=shift;
 464     my %args= $self->get_args();
 465     my $refering_page=$args{refering_page};
 466     my $type= $args{type};  #locus or...?
 467     my $type_id = $args{type_id}; #the database id of the refering object (locus..)
 468     my $GBaccession= sanitize_string($args{accession});
 469     my $user_type = $self->get_user()->get_user_type();
 470     my $script_name= $self->get_script_name();
 471
 472     my $feature = $self->get_object();
 473
 474 ############
 475     my $dbxref_id=undef;
 476
 477     #first fetch the sequence from genbank:
 478     $feature->set_name($GBaccession);
 479     CXGN::Tools::FeatureFetch->new($feature);
 480
 481     my $feature_seqlen=$feature->get_seqlen();
 482     #add genbank verification step
 483     if ($feature->get_message() ) { $self->get_page->message_page("FeatureFetch.pm returned message: " . $feature->get_message()); }
 484     if ( !$feature_seqlen ) {
 485         print  qq |<h3> $GBaccession is not a valid GenBank accession. </h3>  |;
 486         print  qq |<a href="$script_name?type=$type&amp;type_id=$type_id&amp;refering_page=$refering_page&amp;action=new">Go back</a>|;
 487         $self->get_page()->footer();
 488         exit(0);
 489     }
 490
 491     #check to see if the sequence has a valid organism (one that is already in our database)
 492
 493     my $organism = CXGN::Chado::Organism->new_with_taxon_id($self->get_dbh(), $feature->get_organism_taxon_id() );
 494
 495     if( !$organism ) {
 496         my $organism_name = $feature->get_organism_name();
 497         print  qq |<h3> The requested sequence ($GBaccession) corresponds to an unsubmittable organism: $organism_name. If you think this organism should be submittable please contact <a href="mailto:sgn-feedback\@sgn.cornell.edu">sgn-feedback\@sgn.cornell.edu</a></h3>  |;
 498         print qq |<a href="$script_name?type=$type&amp;type_id=$type_id&amp;refering_page=$refering_page&amp;action=new">Go back</a><br />|;
 499
 500         $self->get_page()->footer();
 501         exit(0);
 502     }
 503
 504 ############
 505     my $print_feature =$feature->get_name();#"";
 506     #my @names = $feature->get_names();
 507     ##The first element in the accessions, or "names" under the chado schema, is the nucleotide accession we are interested in.
 508     #my $primary_name = $names[0];
 509     $print_feature .=  ".".$feature->get_version() . " - " . $feature->get_description();
 510
 511     my @print_publications=undef;
 512
 513
 514     my @pubmed_ids=undef;
 515     @pubmed_ids = $feature->get_pubmed_ids();
 516     print STDERR "****pubmed_ids in print_confirm_form are: @pubmed_ids \n";
 517     my $first_pubmed_id = $pubmed_ids[0]; #don't set print_publication to anything if theres no publications to store
 518     my $pubmed_link="";
 519
 520     my $is_associated = undef;
 521     my $show_checkbox = undef;
 522
 523     my $locus=CXGN::Phenome::Locus->new($self->get_dbh(), $type_id);
 524
 525     my $print_associations;
 526
 527     my @loci_feature=$feature->associated_loci();
 528     if (@loci_feature) {$print_associations .= "this sequence is already associated with locus:"; }
 529
 530     foreach my $l(@loci_feature) {
 531         my $l_id= $l->get_locus_id();
 532         my $l_name=$l->get_locus_name();
 533         $print_associations .= qq | <a href= "../phenome/locus_display.pl?locus_id=$l_id">$l_name</a> |;
 534     }
 535
 536     foreach my $pubmed_id (@pubmed_ids){
 537         my $print_publication = undef;
 538         #don't show the publications if they are already associated with this object (locus or allele)
 539         $is_associated= $locus->associated_publication($pubmed_id);
 540         my $pub_obj=CXGN::Chado::Publication->new($self->get_dbh());
 541         my $publication= $pub_obj->get_pub_by_accession($self->get_dbh(), $pubmed_id) ;
 542         if ($publication && !$is_associated) {
 543             my @associated_with_loci = $publication->get_loci();
 544             if (@associated_with_loci) {
 545                 $print_associations .= "<br> this publication is already associated with locus: ";
 546                 foreach my $a(@associated_with_loci) {
 547                     my $a_locus_id= $a->get_locus_id;
 548                     my $a_locus_name=$a->get_locus_name;
 549                     $print_associations .= qq | <a href= "/phenome/locus_display.pl?locus_id=$a_locus_id">$a_locus_name</a> |;
 550                 }
 551             }
 552         }
 553         #########
 554         if(!$is_associated){
 555             $show_checkbox = "yes";
 556             my $publication = CXGN::Chado::Publication->new($feature->get_dbh());
 557             $publication->set_accession($pubmed_id);
 558             $publication->add_dbxref("PMID:$pubmed_id");
 559             CXGN::Tools::Pubmed->new($publication);
 560
 561             $pubmed_link= "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Retrieve&db=pubmed&list_uids=$pubmed_id";
 562             $print_publication .= "<a href= $pubmed_link target=blank>PMID: $pubmed_id </a>";
 563
 564             my @authors= $publication->get_authors();
 565             foreach my $a (@authors) {
 566                 $print_publication .=$a .", ";
 567             }
 568
 569             chop $print_publication;
 570             chop $print_publication;
 571
 572             $print_publication .= ". (" . $publication->get_pyear() . ") " . $publication->get_title() . " " . $publication->get_series_name(). " (" . $publication->get_volume() . "):" . $publication->get_pages() . ". <br><br>";
 573             push(@print_publications, $print_publication);
 574         }
 575     }
 576
 577     print qq | <br/> <h3>The following sequence will be stored in the database and associated with $args{type}  $args{type_id}: </h3> $print_feature|;
 578     if (@print_publications) {
 579         print qq|<br><br><b>Publications related to this sequence:</b><br><br>@print_publications|;
 580     }
 581
 582     print qq | <b> $print_associations </b> |;
 583
 584     $self->init_form();
 585
 586     if ($show_checkbox eq "yes"){ #don't display the checkbox if theres no publications to store
 587         $self->get_form()->add_checkbox( field_name=>"publications_checkbox",
 588                                          display_name=>"<b>Check here to also associate and store the above publication(s)</b>",
 589                                          object=>$self,
 590                                          getter=>"get_checkbox_value",
 591                                          setter=>"set_checkbox_value");
 592     }
 593
 594     $self->get_form()->add_hidden( field_name=>"accession", contents=>$GBaccession );
 595     $self->get_form()->add_hidden( field_name=>"type", contents=>$args{type} );
 596     $self->get_form()->add_hidden( field_name=>"type_id", contents=>$args{type_id} );
 597     $self->get_form()->add_hidden( field_name=>"refering_page", contents=>$args{refering_page} );
 598
 599
 600     $self->get_form()->add_hidden( field_name=>"action", contents=>"store" );
 601
 602     page_title_html("Confirm store");
 603
 604     print qq { <center><br> };
 605
 606     $self->get_form()->as_table();
 607
 608     print qq { </center> };
 609
 610     if ($self->get_action()=~/store/i) {
 611         $self->get_form()->from_request(%args);
 612     }
 613     print qq | <BR> <a href="javascript:history.back(1)">Go back without storing the sequence</a> | ;
 614
 615     $self->get_page()->footer();
 616
 617 }
 618
 619 sub store_publications {
 620     my $self = shift;
 621     my $feature = shift;
 622
 623     my $sp_person_id=$self->get_user()->get_sp_person_id();
 624
 625     my %args = $self->get_args();
 626
 627     my $type= $args{type};  #locus or allele or...?
 628     my $type_id = $args{type_id}; #the database id of the refering object (locus..)
 629
 630     my ($locus, $allele);
 631
 632     ##retrieve the locus or allele objects based on their type_id
 633     if ($type eq 'locus') {  $locus= CXGN::Phenome::Locus->new($self->get_dbh(), $type_id); }
 634     elsif ($type eq 'allele') { $allele= CXGN::Phenome::Allele->new($self->get_dbh(), $type_id); }
 635
 636     ##store the publications associated with the feature
 637     my @pubmed_ids = $feature->get_pubmed_ids();
 638     if(@pubmed_ids) {
 639         print STDERR "***the pubmeds array exists and has the following values: @pubmed_ids";
 640         foreach my $pubmed_id (@pubmed_ids){
 641             my $publication = CXGN::Chado::Publication->new($feature->get_dbh());
 642             $publication->set_accession($pubmed_id);
 643             $publication->add_dbxref("PMID:$pubmed_id");
 644             CXGN::Tools::Pubmed->new($publication);
 645             my $existing_publication = $publication->get_pub_by_accession($self->get_dbh(),$pubmed_id);
 646             if(!($existing_publication->get_pub_id)) { #publication does not exist in our database
 647                 my $e_id = $publication->get_eid;
 648                 if (!$e_id) {
 649                     $publication->add_dbxref("DOI:$e_id");
 650                 }
 651                 print STDERR "storing publication now. pubmed id = $pubmed_id";
 652                 my $pub_id = $publication->store();
 653                 my $publication_dbxref_id = $publication->get_dbxref_id_by_db('PMID');
 654                 my $publication_dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $publication_dbxref_id);
 655
 656                 if ($type eq 'locus') {
 657                     $locus->add_locus_dbxref($publication_dbxref, undef, $sp_person_id);
 658                 }
 659                 elsif ($type eq 'allele'){
 660                     $allele->add_allele_dbxref($publication_dbxref, undef, $sp_person_id);
 661                 }
 662             }
 663             else { #publication exists but is not associated with the object
 664                 print STDERR "***the publication exists but is not associated.";
 665                 $publication=CXGN::Chado::Publication->new($self->get_dbh(), $existing_publication->get_pub_id());
 666                 if (!($publication->is_associated_publication($type, $type_id))) {
 667                     my $publication_dbxref_id= $publication->get_dbxref_id_by_db('PMID');
 668                     my $publication_dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $publication_dbxref_id);
 669
 670                     my ($associated_feature, $obsolete);
 671                     if ($type eq 'locus') {
 672                         $associated_feature = $locus->get_locus_dbxref($publication_dbxref)->get_object_dbxref_id();
 673                         $obsolete = $locus->get_locus_dbxref($publication_dbxref)->get_obsolete();
 674                     }
 675                     elsif ($type eq 'allele') {
 676                         $associated_feature= $allele->get_allele_dbxref($publication_dbxref)->get_allele_dbxref_id();
 677                         $obsolete = $allele->get_allele_dbxref($publication_dbxref)->get_obsolete();
 678                     }
 679
 680                     if ($publication_dbxref_id ) {
 681                         if ($type eq 'locus') {$locus->add_locus_dbxref($publication_dbxref, $associated_feature, $sp_person_id);}
 682                         elsif ($type eq 'allele') { $allele->add_allele_dbxref($publication_dbxref, $associated_feature, $sp_person_id);}
 683                         print STDERR  "associating publication now.";
 684                     }
 685                 }
 686             }
 687         }
 688     }
 689 }
 690
 691 =head2 get_checkbox_value
 692
 693  Usage:
 694  Desc:
 695  Ret:
 696  Args:
 697  Side Effects:
 698  Example:
 699
 700 =cut
 701
 702 sub get_checkbox_value {
 703   my $self=shift;
 704   return $self->{checkbox_value};
 705
 706 }
 707
 708 =head2 set_checkbox_value
 709
 710  Usage:
 711  Desc:
 712  Ret:
 713  Args:
 714  Side Effects:
 715  Example:
 716
 717 =cut
 718
 719 sub set_checkbox_value {
 720   my $self=shift;
 721   $self->{checkbox_value}=shift;
 722 }
 723
 724 sub init_form {
 725     my $self = shift;
 726
 727     if ($self->get_action() =~/edit|^store|new/) {
 728         $self->set_form( CXGN::Page::Form::Editable-> new() );
 729
 730     }elsif ($self->get_action() =~/confirm_store/) {
 731         $self->set_form( CXGN::Page::Form::Editable->new() ) ;
 732
 733     }else  {
 734         $self->set_form( CXGN::Page::Form::Static -> new() );
 735     }
 736
 737 }
 738
 739 sub send_feature_email {
 740     my $self=shift;
 741     my $dbh= $self->get_dbh();
 742     my %args=$self->get_args();
 743     my $action=$args{action};
 744     my $locus_id=$args{type_id};
 745     my $locus=$args{type};
 746     my $GBaccession=sanitize_string($args{accession});
 747     my $feature_id_del = $args{feature_id};
 748     my $acc_obj = CXGN::Chado::Feature->new_with_accession($dbh, $GBaccession);
 749     my $accession;
 750
 751     my $subject="[A Genbank accession is associated or obsoleted] locus $locus_id";
 752     my $username= $self->get_user()->get_first_name()." ".$self->get_user()->get_last_name();
 753     my $sp_person_id=$self->get_user()->get_sp_person_id();
 754
 755     my $locus_link= qq |http://www.sgn.cornell.edu/phenome/locus_display.pl?locus_id=$locus_id|;
 756     my $user_link = qq |http://www.sgn.cornell.edu/solpeople/personal-info.pl?sp_person_id=$sp_person_id|;
 757
 758     my $usermail=$self->get_user()->get_private_email();
 759     my $fdbk_body;
 760
 761     if ($action eq 'delete') {
 762         my $del_acc = CXGN::Chado::Feature->new($dbh, $feature_id_del);
 763         $accession .= $del_acc->get_accession_by_feature_id($GBaccession, $feature_id_del);
 764         my $genbank_deleted= "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Retrieve&db=nuccore&list_uids=$accession";
 765         $fdbk_body="$username ($user_link) has dissociated GenBank accession: $genbank_deleted from  ($locus_link) \n"; }
 766
 767     else {
 768         $accession .= $acc_obj->get_accession_by_feature_id($GBaccession);
 769         my $genbank_added= "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Retrieve&db=nuccore&list_uids=$accession";
 770         $fdbk_body="$username ($user_link) has associated GenBank accession: $genbank_added to locus ($locus_link) \n"; }
 771
 772     CXGN::Contact::send_email($subject,$fdbk_body, 'sgn-db-curation@sgn.cornell.edu');
 773 }
 774