#!/usr/bin/perl package UpdateSeq_base; ####################################################################### ##### Author : Mira Kaloper ##### Date : April 2002 ##### Description : This package contains all necessary methods for ##### updating sequences. ##### ####################################################################### use strict; # use Bio::SeqIO; use Bio::Seq; use DBI; use CGI qw/:all/; # use CGI::Carp qw(fatalsToBrowser); use sdevCreateSeqPage; use sdevSubFeatureObject; use lib "/usr/local/dicty/www_dictybase/db/lib/common"; use Login qw (ConnectToDatabase); use TextUtil qw (DeleteUnwantedChar); use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase"; use dictyBaseCentralMod qw(:formatPage :getInfo); use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/Objects"; use Feature; use ConfigURLdictyBase; use Subfeature; use Subfeature_type; use Coordinate_archive; use Feature_update; use Subfeature_update; use Note; use Note_link; use Reference; use Reflink; use Alias; use Feature_type; $| = 1; ####################################################################### #################### global variables ################################# ####################################################################### our $dbh; our $dblink; our $configUrl; our $locusObj; our $featObj; ####################################################################### sub new { ############ constructor ############################### ####################################################################### my ($type, %args) = @_; my $self = {}; bless $self, $type; $self->{'_database'} = $args{'database'}; $self->{'_help'} = $args{'help'}; $self->{'_title'} = $args{'title'}; $self->{'_submit'} = $args{'submit'}; $self->{'_feature'} = $args{'feature'}; $self->{'_user'} = $args{'user'}; $self->{'_type'} = $args{'type'}; #for merge two features... $self->{_secondary_feature} = $args{'secondary_feature'}; $dblink = ($self->{'_database'} =~ m/dev/i) ? "dictyBaseDEV" : "dictyBase"; return $self; } sub help { $_[0]->{_help} } sub database { $_[0]->{_database} } sub title { $_[0]->{_title} } sub user { $_[0]->{_user} } ###################################################################### sub DESTROY { ############ destructor ############################## ###################################################################### if (defined $dbh) { $dbh->disconnect; } } ###################################################################### sub start{ ###################################################################### my ($self) = @_; $configUrl = ConfigURLdictyBase->new; my ($dbuser, $dbpasswd) = &getUsernamePassword(uc($self->{'_user'}), $self->database); if (!$dbuser || !$dbpasswd) { print "location: ", $configUrl->dictyBaseCGIRoot, $dblink,"/curatorLogin\n"; print "Content-type: text/html\n\n"; exit; } $dbh = &ConnectToDatabase($self->database, $dbuser, $dbpasswd); if (!$self->{'_type'}) { $self->selectUpdateTypePage; exit; } if ($self->{'_type'} eq 'changeFeatureCoord' && !($self->{'_feature'})) { $self->printEntryForm; exit; } if ($self->{'_type'} eq 'changeSubFeatureCoord' && !($self->{'_feature'})) { $self->printEntryForm; exit; } if ($self->{'_type'} eq 'mergeFeatures' && (!($self->{'_feature'}) || !($self->{'_secondary_feature'}))) { $self->printMergeEntryForm; exit; } if ($self->{'_type'} eq 'mergeFeatures') { $self->setVariables; $self->setVariablesForMerge; } else { $self->setVariables; } if (($self->{'_type'} eq 'changeFeatureCoord') && ($self->{'_feature'}) && !param('action') && !param('save')) { $self->printChangeFeatureCoordPage; exit; } if (($self->{'_type'} eq 'changeFeatureCoord') && $self->{'_feature'} && (param('action') eq 'confirm')){ $self->confirmChangeFeatureCoordPage; exit; } if ($self->{'_type'} eq 'changeFeatureCoord' && $self->{'_feature'} && param('save')) { $self->commitChangeFeatureCoordPage; exit; } if (($self->{'_type'} eq 'changeSubFeatureCoord') && ($self->{'_feature'}) && !param('action') && !param('save')) { $self->printChangeSubFeatureCoordPage; exit; } if (($self->{'_type'} eq 'changeSubFeatureCoord') && $self->{'_feature'} && (param('action') eq 'confirm')){ $self->confirmChangeSubFeatureCoordPage; exit; } if ($self->{'_type'} eq 'changeSubFeatureCoord' && $self->{'_feature'} && param('save')) { $self->commitChangeSubFeatureCoordPage; exit; } if (($self->{'_type'} eq 'mergeFeatures') && ($self->{'_feature'}) && ($self->{'_secondary_feature'}) && !param('action') && !param('save')) { $self->printMergeFeaturePage; exit; } if (($self->{'_type'} eq 'mergeFeatures') && $self->{'_feature'} && (param('action') eq 'confirm')){ $self->confirmMergeFeaturesPage; exit; } if ($self->{'_type'} eq 'mergeFeatures' && $self->{'_feature'} && param('save')) { $self->commitMergeFeaturesPage; exit; } exit; } ###################################################################### sub printFeatureChangeDesc { ###################################################################### my $self = shift; print p, 'This page allows you to change the chromosomal coordinates of features. To change the coordinates of an intron or exon within a feature, use the "Change coord of subfeature" tool on the previous page.', p; } ####################################################################### sub printSubFeatureChangeDesc { ####################################################################### my $self = shift; print p, 'This page allows you to change the coordinates of subfeatures (introns, exons) relative to the feature/ORF. To change the coordinates of the feature itself, use the "Change coord of feature" tool on the previous page.', p; } ####################################################################### sub printEntryForm { ####################################################################### my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); if ($self->{'_type'} eq 'changeFeatureCoord') { $self->printFeatureChangeDesc; } elsif ($self->{'_type'} eq 'changeSubFeatureCoord'){ $self->printSubFeatureChangeDesc; } print center(table({-border=>3, -cellpadding=>4, -cellspacing=>4}, Tr({-align=>'LEFT'}, [ td({-bgcolor=>"#b7d8e4", -width=>350}, table({-border=>0}, Tr({align=>'LEFT'}, [ td(start_form, "Enter feature "). td(textfield(-name=>'feature', -size=>'15')), hidden(-name=>'user', -value=>$self->{'_user'}), hidden(-name=>'type', -value=>$self->{'_type'}), td(" "). td(submit(-name=>'submit', -value=>'Submit'), reset, end_form) ])) ) ]))); &printEndPage; } ####################################################################### sub printMergeEntryForm { ####################################################################### my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); print center(table({-border=>3, -cellpadding=>4, -cellspacing=>4}, Tr({-align=>'LEFT'}, [ td({-bgcolor=>"#b7d8e4", -width=>200}, table({-border=>0}, Tr({align=>'LEFT'}, [ td(start_form, "Enter two features to be merge "), td(textfield(-name=>'feature', -size=>'15')), td(textfield(-name=>'secondary_feature', -size=>'15')), hidden(-name=>'user', -value=>$self->{'_user'}), hidden(-name=>'type', -value=>$self->{'_type'}), td(submit(-name=>'submit', -value=>'Submit'), reset, end_form) ])) ) ]))); &printEndPage; } ####################################################################### sub selectUpdateTypePage { ####################################################################### my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); print p, "These tools allow you to change the coordinates of a feature, change the coordinates of a subfeature (ie. introns or exons) within a feature, merge two features, or add sequences for a new feature (Load New Sequence). "; print p, "Note that after making changes via this interface, you need to recreate the fasta flat files on our ftp site via command line scripts. Please talk to Anand or Kara before using these tools.", p; print center(table({-border=>3, -cellpadding=>4, -cellspacing=>4}, Tr({-align=>'LEFT'}, [ td({-bgcolor=>"#b7d8e4"}, table({-border=>0}, Tr({align=>'LEFT'}, [ td(a({-href=>"updateSeq.pl?user=$self->{'_user'}&type=changeFeatureCoord"},"Change coord of feature")), td(a({-href=>"updateSeq.pl?user=$self->{'_user'}&type=changeSubFeatureCoord"},"Change coord of subfeature")), td(a({-href=>"updateSeq.pl?user=$self->{'_user'}&type=mergeFeatures"},"Merge two features")), td(a({-href=>"loadSeq.pl?user=$self->{'_user'}"},"Insert sequence for new feature")), td(a({-href=>"loadSeq.pl?user=$self->{'_user'}&exist=1"},"Update sequence for existing feature")), ])) ) ]))); &printEndPage; } ######################################################################## sub printChangeFeatureCoordPage { ######################################################################## my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); $self->printFeatureChangeDesc; #create subFeatureObject my $subFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, type=>$self->{'_type'}); if (!$subFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } $self->printFeatureHeading($subFeatureObj); print startform(); print (table({-border=>3, -cellpadding=>4, -cellspacing=>4, -bgcolor=>"#b7d8e4"}, Tr({-align=>'LEFT'}, [ th({-align=>'center',colspan=>2},'Enter new coordinates '), th('Start ') . td($self->printStart), th('Stop ') . td($self->printStop), th({colspan=>2},'Public note ', br, $self->enterComment), hidden(-name=>'user', -value=>$self->{'_user'}), th('Reference (Pubmed ID)') . td($self->enterReference), td({colspan=>2},submit(-name=>'submit', -value=>'Submit New Feature Coord')) ]))); my $feature = $self->{'_feature'}; print hidden(-name=>'type', -value=>$self->{'_type'}); print hidden(-name=>'feature', -default=>$feature); print hidden(-name=>'action', -default=>'confirm'); print endform(); &printEndPage; } ######################################################################## sub printChangeSubFeatureCoordPage { ######################################################################## my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); $self->printSubFeatureChangeDesc; my $subFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, type=>$self->{'_type'}); if (!$subFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } $self->printFeatureHeading($subFeatureObj); print startform(); my @rows = $subFeatureObj->getSubFeatureChangeRows; my @empty_rows = $subFeatureObj->printEmptyRows; $subFeatureObj->printSubFeatureHidden; print (table({-border=>3, -cellpadding=>4, -cellspacing=>4, -bgcolor=>"#b7d8e4"}, Tr({-align=>'LEFT'}, [ th({-align=>'center',colspan=>3},'Enter new coordinates for subfeatures '), @rows, @empty_rows, td({colspan=>3},b('Public note '), br, $self->enterComment), th('Reference (Pubmed ID)') . td({colspan=>2}, $self->enterReference), hidden(-name=>'user', -value=>$self->{'_user'}), td({colspan=>3},submit(-name=>'submit', -value=>'Submit New SubFeature Coord')) ]))); my $feature = $self->{'_feature'}; print hidden(-name=>'type', -value=>$self->{'_type'}); print hidden(-name=>'feature', -default=>$feature); print hidden(-name=>'action', -default=>'confirm'); print endform(); &printEndPage; } ######################################################################## sub printMergeFeaturePage { ######################################################################## my $self = shift; &printStartPage($self->database, $self->title, $self->help); #check if two features were submitted... if ($self->{'_feature'} eq $self->{'_secondary_feature'}) { $self->err_report("In order to merge two features you must enter two different feature names"); } #check strand if ($self->{'_strand'} ne $self->{'_sec_strand'}) { $self->err_report("Features must be on the same strand"); } #display primaryfeature Info #create subFeatureObject my $subFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, type=>$self->{'_type'}); if (!$subFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } #display secondaryFeature Info #create subFeatureObject my $secSubFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_sec_chr'}, feature=>$self->{'_secondary_feature'}, type=>$self->{'_type'}); if (!$secSubFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } $subFeatureObj->checkIfSameChromosome($secSubFeatureObj); $subFeatureObj->checkIfNextToEachOtherFeatures($secSubFeatureObj); $self->printFeatureHeading($subFeatureObj); $self->printSecFeatureHeading($secSubFeatureObj); my ($start, $stop); if ($self->{'_strand'} eq 'W') { if ($self->{'_start'} <= $self->{'_sec_start'}) { $start = $self->{'_start'}; } else { $start = $self->{'_sec_start'}; } if ($self->{'_stop'} >= $self->{'_sec_stop'}) { $stop = $self->{'_stop'}; } else { $stop = $self->{'_sec_stop'}; } } else { #it is Crick if ($self->{'_start'} <= $self->{'_sec_start'}) { $start = $self->{'_sec_start'}; } else { $start = $self->{'_start'}; } if ($self->{'_stop'} >= $self->{'_sec_stop'}) { $stop = $self->{'_sec_stop'}; } else { $stop = $self->{'_stop'}; } } print startform(); my @rows; if ($self->{'_strand'} eq 'W') { if ($self->{'_start'} <= $self->{'_sec_start'}) { @rows = $subFeatureObj->getMergeSubFeatureChangeRows($secSubFeatureObj); } else { @rows = $secSubFeatureObj->getMergeSubFeatureChangeRows($subFeatureObj); } } else { #Crick if ($self->{'_start'} <= $self->{'_sec_start'}) { @rows = $secSubFeatureObj->getMergeSubFeatureChangeRows($subFeatureObj); } else { @rows = $subFeatureObj->getMergeSubFeatureChangeRows($secSubFeatureObj); } } $subFeatureObj->printSubFeatureHidden; $secSubFeatureObj->printSecSubFeatureHidden; print p; print (table({-border=>3, -cellpadding=>4, -cellspacing=>4, -bgcolor=>"#b7d8e4"}, Tr({-align=>'LEFT'}, [ th('Enter ORF name') . td({colspan=>2},$self->printORF), th({-align=>'center',colspan=>3},'Enter new start/stop coordinates '), th('Start ') . td({colspan=>2},$self->printStart($start)), th('Stop ') . td({colspan=>2},$self->printStop($stop)), th({-align=>'center',colspan=>3},'Enter new subfeature coordinates '), @rows, td({colspan=>3},b('Public note '), br, $self->enterComment), th('Reference (Pubmed ID)') . td({colspan=>2},$self->enterReference), hidden(-name=>'user', -value=>$self->{'_user'}), td({colspan=>3},submit(-name=>'submit', -value=>'Submit')) ]))); my $feature = $self->{'_feature'}; my $secondary_feature = $self->{'_secondary_feature'}; print hidden(-name=>'type', -value=>$self->{'_type'}); print hidden(-name=>'feature', -default=>$feature); print hidden(-name=>'secondary_feature', -default=>$self->{_secondary_feature}); print hidden(-name=>'action', -default=>'confirm'); print endform(); &printEndPage; } ######################################################################## sub printFeatureHeading{ ######################################################################## my ($self, $subFeatureObj, $new) = @_; my $locus; $locus = "/" . $self->{'_locus_name'} if ($self->{'_locus_name'}); print h4($self->{'_feature'} . $locus); if (!$new) { my @rows = $subFeatureObj->printSubFeature; print table({-border=>3, -cellpadding=>4, -cellspacing=>4, -bgcolor=>"#b7d8e4"}, Tr({-align=>'LEFT'}, [ th(br) . th({-align=>'center',colspan=>2},'Current Info '), th('Chromosome ') . td({colspan=>2},$self->{'_chr'}), th('Start ') . td({colspan=>2},$self->{'_start'}), th('Stop ') . td({colspan=>2},$self->{'_stop'}), th('Strand ') . td({colspan=>2},$self->{'_strand'}), th(br). th({-align=>'center'},'ORF Coord') . th({-align=>'center'},'Chrom Coord'), @rows, ])); } else { my @rows = $subFeatureObj->printSubFeature; my $subFeatureParam = $subFeatureObj->getSubFeatureParam; print table({-border=>3, -cellpadding=>4, -cellspacing=>4, -bgcolor=>"#b7d8e4"}, Tr({-align=>'LEFT'}, [th(br).th({-align=>'center',colspan=>2},'Current Info').th({-align=>'center',colspan=>2},'New Info'), th('Chromosome ').td({colspan=>2},$self->{'_chr'}).td({colspan=>2},$self->{'_chr'}), th('Start ').td({colspan=>2},$self->{'_start'}).td({colspan=>2},$self->{'_new_start'}), th('Stop ').td({colspan=>2},$self->{'_stop'}).td({colspan=>2},$self->{'_new_stop'}), th('Strand ').td({colspan=>2},$self->{'_strand'}).td({colspan=>2},$self->{'_strand'}), # th(br).th({-align=>'center'},'ORF Coord').th({-align=>'center'},'Chrom Coord').th({-align=>'center'},'ORF Coord').th({-align=>'center'},'Chrom Coord'), # @rows, th('Genomic DNA') . td({colspan=>2, align=>'center'}, $self->getLinkToGenomicDNA) . td({colspan=>2, align=>'center'}, $self->getLinkToNewGenomicDNA($subFeatureParam)), th('DNA + 1 kb up/downstream') . td({colspan=>2, align=>'center'}, $self->getLinkToGenomic1K) . td({colspan=>2, align=>'center'}, $self->getLinkToNewGenomic1K($subFeatureParam)), th('Coding Sequence') . td({colspan=>2, align=>'center'}, $self->getLinkToCodingDNA) . td({colspan=>2, align=>'center'}, $self->getLinkToNewCodingDNA($subFeatureParam)), th('Protein') . td({colspan=>2, align=>'center'}, $self->getLinkToProtein) . td({colspan=>2, align=>'center'}, $self->getLinkToNewProtein($subFeatureParam)), th('6FrameTranslation(Genomic)') . td({colspan=>2, align=>'center'}, $self->getLinkTo6FrameTranslation) . td({colspan=>2, align=>'center'}, $self->getLinkToNew6FrameTranslation($subFeatureParam)), #th('6FrameTranslation(Coding)') . td({colspan=>2, align=>'center'}, $self->getLinkTo6FrameTranslationCoding) . td({colspan=>2, align=>'center'}, $self->getLinkToNew6FrameTranslationCoding($subFeatureParam)), th('Public note') . td({colspan=>4},$self->getComment), th('Reference (Pubmed ID)') . td({colspan=>4},$self->getReference) ])); } } ######################################################################## sub printSecFeatureHeading{ ######################################################################## my ($self, $subFeatureObj, $new) = @_; my $locus; $locus = "/" . $self->{'_sec_locus_name'} if ($self->{'_sec_locus_name'}); print h4($self->{'_secondary_feature'} . $locus); if (!$new) { my @rows = $subFeatureObj->printSubFeature; print table({-border=>3, -cellpadding=>4, -cellspacing=>4, -bgcolor=>"#b7d8e4"}, Tr({-align=>'LEFT'}, [ th(br) . th({-align=>'center',colspan=>2},'Current Info '), th('Chromosome ') . td({colspan=>2},$self->{'_sec_chr'}), th('Start ') . td({colspan=>2},$self->{'_sec_start'}), th('Stop ') . td({colspan=>2},$self->{'_sec_stop'}), th('Strand ') . td({colspan=>2},$self->{'_sec_strand'}), th(br). th({-align=>'center'},'ORF Coord') . th({-align=>'center'},'Chrom Coord'), @rows ])); } else { my @rows = $subFeatureObj->printSubFeature; } } ######################################################################## sub printStart { ######################################################################## my ($self,$start) = @_; return textfield(-name=>'start', -default=>$start, -size=>10, -maxlength=>10); } ######################################################################## sub printStop { ######################################################################## my ($self,$stop) = @_; return textfield(-name=>'stop', -default=>$stop, -size=>10, -maxlength=>10); } ######################################################################## sub printORF { ######################################################################## my ($self, $feature) = @_; return textfield(-name=>'ORF', -default=>$feature, -size=>10, -maxlength=>10); } ######################################################################## sub enterComment { ######################################################################## my $self = shift; return textarea(-name=>'comment', -default=>'', -rows=>3, -columns=>60); } ######################################################################## sub enterReference { ######################################################################## my $self = shift; return textfield(-name=>'reference', -default=>'', -size=>10, -maxlength=>10); } ######################################################################## sub checkComment { ######################################################################## my $self = shift; if (!param('comment')) { return "Public note is required field"; } } ######################################################################## sub confirmChangeFeatureCoordPage { ######################################################################## my $self = shift; &printStartPage($self->database, $self->title, $self->help); $self->printFeatureChangeDesc; $self->checkRequiredForChangeFeatureCoordPage; #update coordinates $self->{'_new_start'} = $self->{_start}; $self->{'_new_stop'} = $self->{_stop}; if (param('start')){ $self->{'_new_start'} = param('start'); } if (param('stop')) { $self->{'_new_stop'} = param('stop'); } #create sequeces... my $start = $self->{'_new_start'}; my $stop = $self->{'_new_stop'}; #$self->{'_genomicDNA'} = $seqObject->getGenomicDNASequence; #$self->{'_genomic1KDNA'} = $seqObject->getGenomic1KDNASequence; #$self->{'_codingDNA'} = $seqObject->getCodingDNASequence; #$self->{'_protein'} = $seqObject->getProteinSequence; my $subFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, user=>user, new_start=>$self->{'_new_start'}, new_stop=>$self->{'_new_stop'}, type=>$self->{'_type'}); if (!$subFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } my $seqObject = sdevCreateSeqPage->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, user=>user, start=>$start, stop=>$stop, subFeatureObj=>$subFeatureObj); if (!$seqObject) { print "Could not create sdevCreateSeqPage object \n"; exit; } #$self->{'_genomicDNA'} = $seqObject->getGenomicDNASequence; #$self->{'_genomic1KDNA'} = $seqObject->getGenomic1KDNASequence; #$self->{'_codingDNA'} = $seqObject->getCodingDNASequence; #$self->{'_protein'} = $seqObject->getProteinSequence; $self->checkFeatureCoordChange($seqObject, $subFeatureObj); $self->printFeatureHeading($subFeatureObj,1); print p; print h4("To commit changes you have to click Commit Feature Coord button"); print start_form; $subFeatureObj->printHiddenCoordChanges; print hidden(-name=>'type', -value=>$self->{'_type'}); print hidden(-name=>'feature', -default=>$self->{'_feature'}); print hidden(-name=>'save', -default=>'yes'); print hidden(-name=>'user', -value=>$self->{'_user'}); $self->printHiddenComment; $self->printHiddenReference; print submit(-name=>'submit', -value=>'Commit Feature Coord'), end_form; &printEndPage; } ######################################################################## sub checkRequiredForChangeFeatureCoordPage { ######################################################################## my $self = shift; my $error; if (!param('start') && !param('stop')) { $error = "You have to enter start/stop coordinates!"; } $error .= $self->checkComment; if ($error) { $self->err_report($error); } } ######################################################################## sub checkRequiredForChangeSubFeatureCoordPage { ######################################################################## my $self = shift; my $error; $error .= $self->checkComment; if ($error) { $self->err_report($error); } } ######################################################################## sub checkRequiredForMergeFeatures { ######################################################################## my $self = shift; my $error; my $feature = param('feature'); &DeleteUnwantedChar(\$feature); $feature = uc($feature); my $sec_feature = param('secondary_feature'); &DeleteUnwantedChar(\$sec_feature); $sec_feature = uc($sec_feature); my $orf = param('ORF'); &DeleteUnwantedChar(\$orf); $orf = uc($orf); if (!$orf) { $error .= "You must enter ORF name. "; } if ($orf) { #check if one of the two orfs if (($orf ne $feature) && ($orf ne $sec_feature)) { $error .= "ORF name must be $feature or $sec_feature"; } } $error .= $self->checkComment; if ($error) { $self->err_report($error); } my $primary_feature = $orf; my $merged_feature; my $overwrite; if ($primary_feature eq $feature) { $merged_feature = $sec_feature; $overwrite = 'N'; } else { $merged_feature = $feature; $overwrite = 'Y'; } return($primary_feature,$merged_feature,$overwrite); } ######################################################################## sub confirmChangeSubFeatureCoordPage { ######################################################################## my $self = shift; &printStartPage($self->database, $self->title, $self->help); $self->printSubFeatureChangeDesc; $self->checkRequiredForChangeSubFeatureCoordPage; #check for gaps in the subfeature coordinates... my $subFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, user=>user, new_start=>$self->{'_start'}, new_stop=>$self->{'_stop'}, type=>$self->{'_type'}); if (!$subFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } $subFeatureObj->checkChangeSubFeatureError; #calculate new stop coordinates - start are unchanged... $self->{'_new_start'} = $subFeatureObj->getNewStart; $self->{'_new_stop'} = $subFeatureObj->getNewStop; #setexon/intron info for objects and get SubFeature table my $subFeature = $subFeatureObj->printSubFeature(1); my $seqObject = sdevCreateSeqPage->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, user=>user, start=>$self->{'_start'}, stop=>$self->{'_stop'}); if (!$seqObject) { print "Could not create sdevCreateSeqPage object \n"; exit; } $self->checkSubFeatureCoordChange($subFeatureObj); #$self->{'_genomicDNA'} = $seqObject->getGenomicDNASequence; #$self->{'_genomic1KDNA'} = $seqObject->getGenomic1KDNASequence; #$self->{'_codingDNA'} = $seqObject->getCodingDNASequence; #$self->{'_protein'} = $seqObject->getProteinSequence; print p; $self->printFeatureHeading($subFeatureObj,1); print p; print h4("To commit changes you have to click Commit Feature Coord button"); print start_form; $subFeatureObj->printHiddenCoordChanges; print hidden(-name=>'type', -value=>$self->{'_type'}); print hidden(-name=>'feature', -default=>$self->{'_feature'}); print hidden(-name=>'save', -default=>'yes'); print hidden(-name=>'user', -value=>$self->{'_user'}); $self->printHiddenComment; $self->printHiddenReference; print submit(-name=>'submit', -value=>'Commit SubFeature Coord'), end_form; &printEndPage; } ###################################################################### sub confirmMergeFeaturesPage { ###################################################################### my $self = shift; &printStartPage($self->database, $self->title, $self->help); #this is stupid but have to overwite set variables... my ($primary_feature, $merged_feature, $overwrite) = $self->checkRequiredForMergeFeatures; #overwrite feature info if necessarily... $self->overwriteSetVariables($primary_feature, $merged_feature); my $new_start = param('start'); my $new_stop = param('stop'); #check for gaps in the subfeature coordinates... my $mergedSubFeatureObj = sdevSubFeatureObject->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$primary_feature, user=>user, new_start=>$new_start, new_stop=>$new_stop, type=>$self->{'_type'}); if (!$mergedSubFeatureObj) { print "Could not create sdevSubFeatureObject \n"; exit; } #owerwrite start:stop:subfeature_no for each subfeature #if merge on secondary_feature if ($overwrite eq 'Y') { $mergedSubFeatureObj->overwriteFeatureNoForSubfeatures($primary_feature, $merged_feature); } #check for gaps in the subfeature coordinates.. $mergedSubFeatureObj->checkMergedSubFeatureError; #setexon/intron info for objects and get SubFeature table my $mergedSubFeature = $mergedSubFeatureObj->printSubFeature(1); #calculate new stop coordinates - start are unchanged... $self->{'_new_start'} = $mergedSubFeatureObj->getNewStart; $self->{'_new_stop'} = $mergedSubFeatureObj->getNewStop; # my $seqObject = sdevCreateSeqPage->new(dbh=>$dbh, # database=>$self->{'_database'}, # chrnum=>$self->{'_chr'}, # feature=>$primary_feature, # user=>user, # start=>$self->{'_start'}, # stop=>$self->{'_stop'}); # # if (!$seqObject) { # $self->err_report("Could not create sdevCreateSeqPage object"); # exit; # } print p; $self->printFeatureHeading($mergedSubFeatureObj,1); print p; print h4("To commit changes you have to click Commit Feature Coord button"); print start_form; $mergedSubFeatureObj->printHiddenCoordChanges; print hidden(-name=>'type', -value=>$self->{'_type'}); print hidden(-name=>'primary_feature', -value=>$primary_feature); print hidden(-name=>'merged_feature', -value=>$merged_feature); print hidden(-name=>'feature', -value=>$self->{'_feature'}); print hidden(-name=>'secondary_feature', -value=>$self->{'_secondary_feature'}); print hidden(-name=>'save', -value=>'yes'); print hidden(-name=>'user', -value=>$self->{'_user'}); $self->printHiddenComment; $self->printHiddenReference; print submit(-name=>'submit', -value=>'Commit Merge Features'), end_form; &printEndPage; } ##################################################################### sub checkFeatureCoordChange { ##################################################################### my ($self, $seqObject, $subFeatureObj) = @_; my $start = param('start'); my $stop = param('stop'); my $error; if (!$start && !$stop) { $self->err_report("You have to enter start/stop coordinates!"); } #check start and stop of coding sequence ... my $seq_error = $seqObject->checkSequenceChange; #check sum of exons... my $sum_error = $subFeatureObj->checkSubFeatureSum; if ($sum_error || $seq_error) { print p, font({-size=>"+1",-color=>"red"},"Go back using your browser to make changes. \n"), br; } } ##################################################################### sub checkSubFeatureCoordChange { ##################################################################### my ($self, $subFeatureObj) = @_; my $start = param('start'); my $stop = param('stop'); my $error; #check start and stop of coding sequence ... #we don't have to check this when changing subfeatureobject since #we cannot change start/stop coordinates of a feature #my $seq_error = $seqObject->checkSequenceChange; #check sum of exons... my $sum_error = $subFeatureObj->checkSubFeatureSum; if ($sum_error) { print p, font({-size=>"+1",-color=>"red"},"Go back using your browser to ma ke changes. \n"), br; } } ####################################################################### sub printLinkToGenomicDNA { ####################################################################### my $self = shift; print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=genomicDNA&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence", -target=>'new_seq_window'},"Display Genomic DNA sequence"), br; } ####################################################################### sub getLinkToGenomicDNA { ####################################################################### my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=genomicDNA&start=$self->{'_start'}&stop=$self->{'_stop'}&action=getSequence&type=Current", -target=>'seq_window'},"Display"), br; } ####################################################################### sub getLinkToNewGenomicDNA { ####################################################################### my ($self,$subFeatureParam) = @_; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=genomicDNA&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence&type=New&$subFeatureParam", -target=>'new_seq_window'},"Display"), br; } ######################################################################## sub printLinkToCodingDNA { ######################################################################## my $self = shift; print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=codingDNA&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence", -target=>'new_seq_window'},"Display Coding sequence"), br; } ######################################################################## sub getLinkToCodingDNA { ######################################################################## my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=codingDNA&start=$self->{'_start'}&stop=$self->{'_stop'}&action=getSequence&type=Current", -target=>'seq_window'},"Display"), br; } ######################################################################## sub getLinkToNewCodingDNA { ######################################################################## my ($self,$subFeatureParam) = @_; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=codingDNA&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence&type=New&$subFeatureParam", -target=>'new_seq_window'},"Display"), br; } ######################################################################## sub printLinkToProtein { ######################################################################## my $self = shift; print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=protein&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence", -target=>'new_seq_window'},"Display Protein sequence"), br; } ######################################################################## sub getLinkToProtein { ######################################################################## my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=protein&start=$self->{'_start'}&stop=$self->{'_stop'}&action=getSequence&type=Current", -target=>'seq_window'},"Display"), br; } ######################################################################## sub getLinkToNewProtein { ######################################################################## my ($self, $subFeatureParam) = @_; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=protein&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence&type=New&$subFeatureParam", -target=>'new_seq_window'},"Display"), br; } ######################################################################## sub printLinkToGenomic1K { ######################################################################## my $self = shift; print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=genomic1KDNA&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence", -target=>'new_seq_window'},"Display Genomic 1K sequence"), br; } ######################################################################## sub getLinkToGenomic1K { ######################################################################## my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=genomic1KDNA&start=$self->{'_start'}&stop=$self->{'_stop'}&action=getSequence&type=Current", -target=>'seq_window'},"Display"), br; } ######################################################################## sub getLinkToNewGenomic1K { ######################################################################## my ($self,$subFeatureParam) = @_; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&seqtype=genomic1KDNA&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence&type=New&$subFeatureParam", -target=>'new_seq_window'},"Display"), br; } ####################################################################### sub printLinkTo6FrameTranslation { ####################################################################### my $self = shift; print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&map=rmap&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence", -target=>'new_seq_window'},"Display"), br; } ####################################################################### sub printLinkTo6FrameTranslationCoding { ####################################################################### my $self = shift; print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage. pl?user=$self->{'_user'}&feature=$self->{'_feature'}&map=rmap&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence", -target=>'new_seq_window'},"Display 6 Frame Translation"), br; } ####################################################################### sub getLinkTo6FrameTranslation { ####################################################################### my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&map=rmap&start=$self->{'_start'}&stop=$self->{'_stop'}&action=getSequence&type=Current", -target=>'seq_window'},"Display"), br; } ####################################################################### sub getLinkTo6FrameTranslationCoding { ####################################################################### my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&map=rmap&start=$self->{'_start'}&stop=$self->{'_stop'}&action=getSequence&type=Current", -target=>'seq_window'},"Display"), br; } ####################################################################### sub getLinkToNew6FrameTranslation { ####################################################################### my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&map=rmap&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence&type=New", -target=>'new_seq_window'},"Display"), br; } ####################################################################### sub getLinkToNew6FrameTranslationCoding { ####################################################################### my $self = shift; return a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/createSeqPage.pl?user=$self->{'_user'}&feature=$self->{'_feature'}&map=rmap&start=$self->{'_new_start'}&stop=$self->{'_new_stop'}&action=getSequence&type=New", -target=>'new_seq_window'},"Display"), br; } ######################################################################## sub getComment { ######################################################################## my $self = shift; return param('comment'); } ######################################################################## sub printHiddenComment { ######################################################################## my $self = shift; print hidden(-name=>'comment', -value=>$self->getComment); } ######################################################################## sub getReference { ######################################################################## my $self = shift; return param('reference'); } ######################################################################## sub printHiddenReference { ######################################################################## my $self = shift; print hidden(-name=>'reference', -value=>$self->getReference); } ######################################################################## sub commitChangeFeatureCoordPage { ######################################################################## my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); my $feature = $self->{'_feature'}; print h4("Feature Name: $feature"); #check if need to update feature table if (($self->{'_start'} eq param('new_start')) && ($self->{'_stop'} eq param('new_stop'))) { print p, h4("There was no change to start and stop feature coordinates. No changes to database were commited"); &printEndPage; return; } eval { #update Feature table $self->updateFeatureCoord; #update feature_update table $self->updateFeatureUpdate; #updates subfeature coordinates. Also inserts new coordinates $self->updateSubFeatureCoord; #deletes and inserts sequences that has changed into display_seq table $self->updateSequences; #Inserts comment into Note table $self->updateNote; #Inserts pubmed into reflink table $self->updateReference; }; if ($@) { print "An Error Occurred!: $@"; $dbh->rollback; $dbh->disconnect; exit(1); } else { if ($self->{'_updateCount'}) { $dbh->commit; $self->dbSucessfull; #print p, h4("Database has been updated sucessfully"); } else { print p, h4("No changes to database were commited"); } } &printEndPage; } ######################################################################## sub commitChangeSubFeatureCoordPage { ######################################################################## my ($self) = shift; &printStartPage($self->database, $self->title, $self->help); my $feature = $self->{'_feature'}; print h4("Feature Name: $feature"); eval { #we are not updating Feature table in this scenarion #$self->updateFeatureCoord; #update feature_update table with NULL fro start/stop coordinate $self->updateFeatureUpdate; #updates subfeature coordinates. Also inserts new coordinates $self->updateSubFeatureCoord; #deletes and inserts sequences that has changed into display_seq table $self->updateSequences; #Inserts comment into Note table $self->updateNote; #Inserts pubmed into reflink table $self->updateReference; }; if ($@) { print "An Error Occurred!: $@"; $dbh->rollback; $dbh->disconnect; exit(1); } else { $dbh->commit; #$dbh->rollback; $self->dbSucessfull; #print p, h4("Database has been updated sucessfully"); } } ######################################################################## sub commitMergeFeaturesPage{ ######################################################################## my ($self) = @_; &printStartPage($self->database, $self->title, $self->help); my $feature = param('primary_feature'); &DeleteUnwantedChar(\$feature); $feature = uc($feature); #set variables to appropriate values $self->{'_feature'} = $feature; $self->setVariables; #set variables for merge feature... my $merged_feature = param('merged_feature'); &DeleteUnwantedChar(\$merged_feature); $merged_feature = uc($merged_feature); $self->{'_secondary_feature'} = $merged_feature; $self->setVariablesForMerge; print h4("Feature Name: $feature"); eval { #we are not updating Feature table in this scenarion $self->updateFeatureCoord; #update feature_update table with NULL fro start/stop coordinate $self->updateFeatureUpdate; #updates subfeature coordinates. Also inserts new coordinates $self->updateSubFeatureCoord; #deletes and inserts sequences that has changed into display_seq table $self->updateSequences; #Inserts comment into Note table #we want to save note for secondary_feature as well... $self->updateNote('Y'); #Inserts pubmed into reflink table #we want to save reference for secondary_feature as well... $self->updateReference('Y'); #Add merged ORF feature_name as an alias in the ALIAS table $self->updateAlias; #Add row into Feature_type table with type = Merged $self->updateFeatureType; #update is_on_pmap = 'N' for merged feature $self->updateFeatureIsOnPmap; }; if ($@) { print "An Error Occurred!: $@"; $dbh->rollback; $dbh->disconnect; exit(1); } else { $dbh->commit; #$dbh->rollback; $self->dbSucessfull; #print p, h4("Database has been updated sucessfully"); } } ######################################################################## sub updateFeatureUpdate{ ######################################################################## my ($self) = @_; #check if need to update subfeature table if ($self->{_type} eq 'changeFeatureCoord') { if (($self->{'_start'} eq param('new_start')) && ($self->{'_stop'} eq param('new_stop'))) { return; } } my ($new_start,$new_stop); #set new_start and new_stop coordinates when parameters are passed #when no parameters this will default to null in database if ($self->{'_start'} ne param('new_start')) { $new_start = param('new_start'); } if ($self->{'_stop'} ne param('new_stop')) { $new_stop = param('new_stop'); } my $chrObj = Chromosome->new(dbh=>$dbh, chromosome=>$self->{'_chrnum'}); my $chr_version = $chrObj->chr_version; my $feature_version = $self->{'_feature_version'}; Feature_update->Insert(dbh=>$dbh, literals=>{FEATURE_UPDATE_NO=>'CGM_DDB.FEATUPDNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{FEATURE_NO=>$self->{'_feature_no'}, OLD_START_COORD=>$self->{'_start'}, NEW_START_COORD=>$new_start, OLD_STOP_COORD=>$self->{'_stop'}, NEW_STOP_COORD=>$new_stop, FEATURE_VERSION=>$feature_version, CHR_VERSION=>$chr_version, CREATED_BY=>$self->{'_user'}}); } ######################################################################## sub updateFeatureCoord { ######################################################################## my ($self) = @_; my $featObj = Feature->new(dbh=>$dbh, feature_name=>$self->{'_feature'}); if (!$featObj) { print "Something is wrong with feature object \n"; exit(); } #check if need to update feature table if (($self->{'_start'} eq param('new_start')) && ($self->{'_stop'} eq param('new_stop'))) { return; } if ($self->{'_start'} ne param('new_start')) { my $new_start = param('new_start'); print "Updating start coordinate to $new_start", br; $featObj->updateStart_Coord($new_start); } if ($self->{'_stop'} ne param('new_stop')) { my $new_stop = param('new_stop'); print "Updating stop coordinate to $new_stop", br; $featObj->updateStop_coord($new_stop); } my $sysDate = Feature->GetSysDate(dbh=>$dbh); $featObj->updateFeature_version($sysDate); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; $featObj->enterUpdates; } ######################################################################## sub getFeatureUpdateNo { ######################################################################## my $self = shift; my $sth = $dbh->prepare( "SELECT CGM_DDB.FEATUPDNO_SEQ.currval FROM dual"); $sth->execute(); my $featureUpdateNo = $sth->fetchrow; $sth->finish; return $featureUpdateNo; } ######################################################################## sub getSubFeatureNo { ######################################################################## my $self = shift; my $sth = $dbh->prepare( "SELECT CGM_DDB.SUBFEATNO_SEQ.currval FROM dual"); $sth->execute(); my $subFeatureNo = $sth->fetchrow; $sth->finish; return $subFeatureNo; } ######################################################################## sub updateSubFeatureCoord { ######################################################################## my $self = shift; #get subfeature_no from dual my $featureUpdateNo = $self->getFeatureUpdateNo; $self->loopUpdateSubFeatureCoord('Exon',$featureUpdateNo); $self->loopUpdateSubFeatureCoord('Intron',$featureUpdateNo); } ####################################################################### sub updateNote { ####################################################################### my ($self, $update_sec_feature) = @_; my $note = $self->getComment; if (!$note) { return; } print "Updating note table with: $note for " . $self->{'_feature_no'}, br; my $noteObj = Note->new(dbh=>$dbh, note=>$note); if (!$noteObj) { $noteObj = $self->insertNoteTable($note); } if ($noteObj) { my $noteNo = $noteObj->note_no; my $noteLinkObj = Note_link->new(dbh=>$dbh, note_no=>$noteNo, tab_name=>'FEATURE', primary_key=>$self->{'_feature_no'}); if (!$noteLinkObj) { $self->insertNoteLinkTable($noteNo, $self->{'_feature_no'}); } $self->{'_updateCount'}++; } if ($update_sec_feature eq 'Y') { print "Updating note table with: $note for " . $self->{'_sec_feature_no'}, br; if ($noteObj) { my $noteNo = $noteObj->note_no; my $noteLinkObj = Note_link->new(dbh=>$dbh, note_no=>$noteNo, tab_name=>'FEATURE', primary_key=>$self->{'_sec_feature_no'}); if (!$noteLinkObj) { $self->insertNoteLinkTable($noteNo, $self->{'_sec_feature_no'}); } $self->{'_updateCount'}++; } } } ######################################################################## sub insertNoteTable { ######################################################################## my ($self, $note) = @_; Note->Insert(dbh=>$dbh, literals=>{NOTE_NO=>'CGM_DDB.NOTENO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{NOTE=>$note, CREATED_BY=>$self->{'_user'}}); my $noteObj = Note->new(dbh=>$dbh, note=>$note); return $noteObj; } ####################################################################### sub insertNoteLinkTable { ####################################################################### my ($self, $noteNo, $featNo) = @_; Note_link->Insert(dbh=>$dbh, literals=>{NOTE_LINK_NO=>'CGM_DDB.NOTELINKNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{NOTE_NO=>$noteNo, TAB_NAME=>'FEATURE', PRIMARY_KEY=>$featNo, CREATED_BY=>$self->{'_user'}}); } ######################################################################## sub updateReference { ######################################################################## my ($self, $update_sec_feature) = @_; my $pubmed = $self->getReference; my $refObject = Reference->new(dbh=>$dbh, pubmed=>$pubmed); if (!$refObject) { return; } my $reference_no = $refObject->reference_no; my $featureUpdateNo = $self->getFeatureUpdateNo; print "Updating reflink table with $reference_no for " . $self->{'_feature_no'}, br; Reflink->Insert(dbh=>$dbh, literals=>{REFLINK_NO=>'CGM_DDB.REFLINKNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{REFERENCE_NO=>$reference_no, TAB_NAME=>'FEATURE_UPDATE', PRIMARY_KEY=>$featureUpdateNo, PRIMARY_KEY_COL=>'FEATURE_UPDATE_NO', CREATED_BY=>$self->{'_user'}}); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; if ($update_sec_feature eq 'Y') { print "Updating reflink table with $reference_no for " . $self->{'_feature_no'}, br; Reflink->Insert(dbh=>$dbh, literals=>{REFLINK_NO=>'CGM_DDB.REFLINKNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{REFERENCE_NO=>$reference_no, TAB_NAME=>'FEATURE_UPDATE', PRIMARY_KEY=>$self->{'_sec_feature_no'}, PRIMARY_KEY_COL=>'FEATURE_UPDATE_NO', CREATED_BY=>$self->{'_user'}}); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; } } ######################################################################## sub updateAlias { ######################################################################## my $self = shift; print "Updating Alias table with ALIAS_NAME ".$self->{'_secondary_feature'}. " FEATURE_NO ".$self->{'_feature_no'}, br; Alias->Insert(dbh=>$dbh, literals=>{ALIAS_NO=>'CGM_DDB.ALIASNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{ALIAS_NAME=>$self->{'_secondary_feature'}, FEATURE_NO=>$self->{'_feature_no'}, CREATED_BY=>$self->{'_user'}}); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; } ######################################################################## sub updateFeatureType { ######################################################################## my $self = shift; print "Updating Feature_type table with " . $self->{'_sec_feature_no'}, br; Feature_type->Insert(dbh=>$dbh, literals=>{DATE_CREATED=>'SYSDATE'}, binds=>{FEATURE_NO=>$self->{'_sec_feature_no'}, FEATURE_TYPE=>'Merged', CREATED_BY=>$self->{'_user'}}); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; } ######################################################################## sub updateFeatureIsOnPmap { ######################################################################## my ($self) = @_; print "Updating is_on_pmap to 'N' for merged feature", br; my $featObj = Feature->new(dbh=>$dbh, feature_no=>$self->{'_sec_feature_no'}); if ($featObj) { $featObj->updateIs_on_pmap('N'); $featObj->enterUpdates; } else { print "The feature_no = ", $self->{'_sec_feature_no'}, " is not found in database.", br; } $self->{'_updateCount'}++; } ######################################################################## sub updateSequences { ######################################################################## my $self = shift; #create sequeces... my $start = param('new_start'); my $stop = param('new_stop'); print "start = $start", br; print "stop = $stop", br; my $seqObject = sdevCreateSeqPage->new(dbh=>$dbh, database=>$self->{'_database'}, chrnum=>$self->{'_chr'}, feature=>$self->{'_feature'}, user=>user, start=>$start, stop=>$stop); if (!$seqObject) { print "Could not create sdevCreateSeqPage object \n"; exit; } my $genomicDNA = $seqObject->getGenomicDNASequence; my $genomic1KDNA = $seqObject->getGenomic1KDNASequence; my $codingDNA = $seqObject->getCodingDNASequence; my $protein = $seqObject->getProteinSequence; #DNA coding sequence #Genomic DNA #Genomic DNA +/- 1000bp #Protein $self->deleteInsertSequence('Genomic DNA',$genomicDNA); $self->deleteInsertSequence('Genomic DNA +/- 1000bp',$genomic1KDNA); $self->deleteInsertSequence('DNA coding sequence',$codingDNA); $self->deleteInsertSequence('Protein',$protein); } ######################################################################## sub doUpdateSeq { ######################################################################## my ($self, $type, $sequence) = @_; my $rawSeqObj = Raw_sequence->new(dbh=>$dbh, raw_seq_type=>$type, tab_name=>'FEATURE', primary_key=>$self->{'_feature_no'}); my $oldSequence = $rawSeqObj->raw_seq; #when no change to the sequence exit this method if ($oldSequence eq $sequence) { print "$type sequence is the same - no need to update raw_seq table", br; return; } #if raw_sequence doesn't exists create it if (!$rawSeqObj) { #updateSequence #$self->deleteInsertSequence($type,$sequence); } my $seqlen = length($sequence); print "Updating $type sequence ... \n", br; $rawSeqObj->updateRaw_seq_length($seqlen); my $sysDate = Raw_sequence->GetSysDate(dbh=>$dbh); $rawSeqObj->updateSeq_version($sysDate); $rawSeqObj->updateRaw_seq($sequence); $rawSeqObj->enterUpdates; $self->{'_updateCount'} = $self->{'_updateCount'} + 1; } ######################################################################## sub deleteInsertSequence { ######################################################################## my ($self, $type, $sequence) = @_; # my $displaySeqObj = Display_seq->new(dbh=>$dbh, # display_seq_type=>$type, # feature_no=>$self->{'_feature_no'}); # # # my $oldSequence = $displaySeqObj->display_seq; # # #when no change to the sequence exit this method # if ($oldSequence eq $sequence) { # print "$type sequence is the same - no need to update raw_seq table", br; # return; # } # # #if raw_sequence exists delete it # if ($displaySeqObj) { # $displaySeqObj->delete; # } # my $seqlen = length($sequence); my $dbuser = $self->{'_user'}; print "Updating $type sequence ... \n", br; Display_seq->Insert(dbh=>$dbh, literals=>{display_seq_no=>'CGM_DDB.DISPLAYSEQNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{FEATURE_NO=>$self->{'_feature_no'}, DISPLAY_SEQ_TYPE=>$type, SEQ_LENGTH=>$seqlen, CREATED_BY=>$dbuser, DISPLAY_SEQ=>$sequence}); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; } ######################################################################## sub loopUpdateSubFeatureCoord { ######################################################################## my ($self,$type,$featureUpdateNo) = @_; my $feature_no = $self->{'_feature_no'}; my %hashSubFeatureNo = Subfeature->GetSubFeatureNoHash(dbh=>$dbh, feature_no=>$self->{'_feature_no'}); my $i = 1; my $heading = $type . $i; while (param("$heading")) { my $value = param("$heading"); my($new_start, $new_stop, $subfeatureNo) = split (/:/,$value); #update subfeature table if changes to exon/intron coordinates my $subfeatureObj = Subfeature->new(dbh=>$dbh, subfeature_no=>$subfeatureNo) ; if (!$subfeatureObj) { #create subfeature object for: $subfeatureNo $self->insertSubFeatureCoord($type,$new_start,$new_stop,$featureUpdateNo); $i++; $heading = $type . $i; next; } #we processed this subfeature - it is no longer candidate for deletion delete($hashSubFeatureNo{$subfeatureNo}); my $start= $subfeatureObj->start_coord; my $stop = $subfeatureObj->stop_coord; #check if need to update if (($start eq $new_start) && ($stop eq $new_stop)) { $i++; $heading = $type . $i; next; } if ($start ne $new_start) { print "Updating subfeature object: $heading with start_coord = $new_start", br; $subfeatureObj->updateStart_coord($new_start); } else { #undef $new_start; } if ($stop ne $new_stop) { print "Updating subfeature object $heading with stop_coord = $new_stop", br; $subfeatureObj->updateStop_coord($new_stop); } else { #undef $new_stop; } my $subfeature_no = $subfeatureObj->subfeature_no; $self->updateSubFeatureUpdate($subfeature_no,$featureUpdateNo,$start,$new_start,$stop, $new_stop); $subfeatureObj->enterUpdates; $i++; $heading = $type . $i; } #delete any unprocessed subfeatures that are still in the hash... if (($self->{_type} eq 'changeSubFeatureCoord') || ($self->{_type} eq 'changeFeatureCoord')) { foreach my $sub_feature_no (keys %hashSubFeatureNo) { if ($hashSubFeatureNo{$sub_feature_no} eq $type) { $self->deleteFromSubFeature($sub_feature_no); } } } } ####################################################################### sub deleteFromSubFeature { ####################################################################### my ($self, $subFeatureNo) = @_; #we will not delete subfeatures, but instead insert a new column #into subfeature_type where type = Delete print "flaging $subFeatureNo as Deleted in subfeature_type table", br; Subfeature_type->Insert(dbh=>$dbh, literals=>{SUBFEATURE_NO=>$subFeatureNo, DATE_CREATED=>'SYSDATE'}, binds=>{SUBFEATURE_TYPE=>'Deleted', CREATED_BY=>$self->{'_user'}}); } ####################################################################### sub insertSubFeatureCoord { ####################################################################### my ($self, $type, $start, $stop, $featureUpdateNo) =@_; print "Inserting new $type into subfeature with $start-$stop coordinate", br; Subfeature->Insert(dbh=>$dbh, literals=>{SUBFEATURE_NO=>'CGM_DDB.SUBFEATNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{FEATURE_NO=>$self->{'_feature_no'}, #SUBFEATURE_TYPE=>$type, START_COORD=>$start, STOP_COORD=>$stop, CREATED_BY=>$self->{'_user'}}); my $subFeatureNo = $self->getSubFeatureNo; print "Inserting $type into subfeature_type table", br; Subfeature_type->Insert(dbh=>$dbh, literals=>{SUBFEATURE_NO=>$subFeatureNo, DATE_CREATED=>'SYSDATE'}, binds=>{SUBFEATURE_TYPE=>$type, CREATED_BY=>$self->{'_user'}}); #we don't want to archive changes to insertion of new subfeatures... #$self->updateSubFeatureUpdate($subFeatureNo,$featureUpdateNo,undef,$start,undef,$stop); $self->{'_updateCount'} = $self->{'_updateCount'} + 1; } ######################################################################## sub updateSubFeatureUpdate { ######################################################################## my ($self, $subfeature_no, $featureUpdateNo, $start, $new_start, $stop, $new_stop) = @_; Subfeature_update->Insert(dbh=>$dbh, literals=>{SUBFEATURE_UPDATE_NO=>'CGM_DDB.SUBFEATUPDNO_SEQ.NEXTVAL', DATE_CREATED=>'SYSDATE'}, binds=>{SUBFEATURE_NO=>$subfeature_no, FEATURE_UPDATE_NO=>$featureUpdateNo, OLD_START_COORD=>$start, NEW_START_COORD=>$new_start, OLD_STOP_COORD=>$stop, NEW_STOP_COORD=>$new_stop, CREATED_BY=>$self->{'_user'}}); } ######################################################################## sub setVariables { ######################################################################## my ($self) = @_; $self->{'_feature'} = uc($self->{'_feature'}); my $feature = $self->{'_feature'}; &DeleteUnwantedChar(\$feature); $self->{'_feature'} = $feature; if ($feature) { my $featureObj = Feature->new(dbh=>$dbh, feature_name=>$feature); if (!$featureObj) { &printStartPage($self->database, $self->title, $self->help); $self->err_report("There is no feature_name associated with $feature in the database."); } $self->{'_feature_no'} = $featureObj->feature_no; $self->{'_chrnum'} = $featureObj->chromosome; $self->{'_beg'} = $featureObj->start_coord; $self->{'_end'} = $featureObj->stop_coord; $self->{'_locus_name'} = $featureObj->locus_name; $self->{'_chr'} = $featureObj->chromosome; $self->{'_start'} = $featureObj->start_coord; $self->{'_stop'} = $featureObj->stop_coord; $self->{'_strand'} = $featureObj->strand; $self->{'_feature_version'} = $featureObj->feature_version; } } ################################################################### sub setVariablesForMerge { ################################################################### my $self = shift; #seting up data for secondary_feature... #I know that this is not written well, since it is a duplicate of the previos one... $self->{'_secondary_feature'} = uc($self->{'_secondary_feature'}); my $feature = $self->{'_secondary_feature'}; &DeleteUnwantedChar(\$feature); $self->{'_secondary_feature'} = $feature; if ($feature) { my $featureObj = Feature->new(dbh=>$dbh, feature_name=>$feature); if (!$featureObj) { &printStartPage($self->database, $self->title, $self->help); $self->err_report("There is no feature_name associated with $feature in the database."); } $self->{'_sec_feature_no'} = $featureObj->feature_no; $self->{'_sec_chrnum'} = $featureObj->chromosome; $self->{'_sec_locus_name'} = $featureObj->locus_name; $self->{'_sec_chr'} = $featureObj->chromosome; $self->{'_sec_start'} = $featureObj->start_coord; $self->{'_sec_stop'} = $featureObj->stop_coord; $self->{'_sec_strand'} = $featureObj->strand; $self->{'_sec_feature_version'} = $featureObj->feature_version; } } #################################################################### sub overwriteSetVariables { #################################################################### my ($self, $primary_feature, $merged_feature) = @_; if ($primary_feature ne $self->{'_feature'}) { ($self->{'_feature'}, $self->{'_secondary_feature'}) = ($self->{'_secondary_feature'}, $self->{'_feature'}); ($self->{'_feature_no'}, $self->{'_sec_feature_no'})= ($self->{'_sec_feature_no'}, $self->{'_feature_no'}); ($self->{'_locus_name'},$self->{'_sec_locus_name'}) = ( $self->{'_sec_locus_name'}, $self->{'_locus_name'}); ($self->{'_start'}, $self->{'_sec_start'}) = ($self->{'_sec_start'}, $self->{'_start'}); ($self->{'_stop'}, $self->{'_sec_stop'}) = ($self->{'_sec_stop'}, $self->{'_stop'}); ($self->{'_strand'}, $self->{'_sec_strand'}) = ($self->{'_sec_strand'}, $self->{'_strand'}); ($self->{'_feature_version'}, $self->{'_sec_feature_version'}) = ($self->{'_sec_feature_version'}, $self->{'_feature_version'}); } } ######################################################################## sub dbSucessfull{ ######################################################################## my $self = shift; print p, h4("Database has been updated sucessfully"); if ($self->{'_database'} =~ /^dictyBase/i) { print p, font({-size=>"+1",-color=>"red"},"Be sure to run the necessary programs to recreate the fasta data files:\n"), p; print "In a wine window, run the following programs in /share/dictyBase/bin/fasta/", p; print ul(li("createFastaFilesFromChr.pl ".br."-run this 3 times, each time passing a different parameter."). li("createNotFile.pl")),p; } } ######################################################################## sub err_report { ######################################################################## my ($self, $err) = @_; print font({-size=>"+1",-color=>"red"},"$err!\n"), br; &printEndPage; $dbh->disconnect; exit; } ######################################################################## 1; ##################################################################### ########################################################################