view release on metacpan or  search on metacpan

Genetics/API/DB/Update.pm  view on Meta::CPAN

    if ( defined($bound = $sv->field("lowerBound")) ) {
      $sth = $dbh->prepare( "update StudyVariable 
                           set numberLowerBound = ? 
                           where studyVariableID = ?" ) ;
    if ($bound eq "DELETE") {
      $sth->execute(undef, $id) ;
    } else {
      $sth->execute($bound, $id) ;
    }
    $sth->finish() ;
    }
    if ( defined($bound = $sv->field("upperBound")) ) {
      $sth = $dbh->prepare( "update StudyVariable 
                           set numberUpperBound = ? 
                           where studyVariableID = ?" ) ;
    if ($bound eq "DELETE") {
      $sth->execute(undef, $id) ;
    } else {
      $sth->execute($bound, $id) ;
    }
    $sth->finish() ;
    }
  }
  if ($format eq "Date") {
    if ( defined($bound = $sv->field("lowerBound")) ) {
      $sth = $dbh->prepare( "update StudyVariable 
                           set dateLowerBound = ? 
                           where studyVariableID = ?" ) ;
    if ($bound eq "DELETE") {
      $sth->execute(undef, $id) ;
    } else {
      $sth->execute($bound, $id) ;
    }
    $sth->finish() ;
    }
    if ( defined($bound = $sv->field("upperBound")) ) {
      $sth = $dbh->prepare( "update StudyVariable 
                           set dateUpperBound = ? 
                           where studyVariableID = ?" ) ;
    if ($bound eq "DELETE") {
      $sth->execute(undef, $id) ;
    } else {
      $sth->execute($bound, $id) ;
    }
    $sth->finish() ;
    }
  }
  if ($format eq "Code") {
    if ( defined($codesListPtr = $sv->field("Codes")) ) {
      $sth = $dbh->prepare(" select codeDerivationID from CodeDerivation 
                             where studyVariableID = $id" ) ;
      $sth->execute() ;
      while ($arrRef = $sth->fetchrow_arrayref()) {
	$dbh->do( "delete from  StaticLCPenetrance
                   where cdID = $$arrRef[0]" ) ;
      }
      $dbh->do( "delete from CodeDerivation 
                 where studyVariableID = $id" ) ;
      
      $sth = $dbh->prepare( "insert into CodeDerivation 
                             (codeDerivationID, studyVariableID, code, description, formula) 
                             values (?, ?, ?, ?, ?)" ) ;
      if ($category eq "StaticLiabilityClass") {
	$sth1 = $dbh->prepare( "insert into StaticLCPenetrance 
                                (cdID, pen11, pen12, pen22, malePen1, malePen2)
                                values (?, ?, ?, ?, ?, ?)" ) ;
      }
      foreach $codePtr (@$codesListPtr) {
	$sth->execute(undef, $id, $$codePtr{code}, $$codePtr{description}, undef) ;
	$cdID = $sth->{'mysql_insertid'} ;
	if ($category eq "StaticLiabilityClass") {
	  $sth1->execute($cdID, $$codePtr{pen11}, $$codePtr{pen12}, $$codePtr{pen22}, $$codePtr{malePen1}, $$codePtr{malePen2}) ;
	}
      }
      $sth->finish() ;
    }
  }
  if ($category =~ /AffectionStatus$/) {
    ( $oldAsdID ) = $dbh->selectrow_array( "select asDefID from AffectionStatusDefinition 
                                            where studyVariableID = $id" ) ;
    if ( defined($asdPtr = $sv->field("AffStatDef")) ) {
      $dbh->do( "delete from AffectionStatusDefinition 
                 where studyVariableID = $id" ) ;
      $sth = $dbh->prepare( "insert into AffectionStatusDefinition 
                             (asDefID, studyVariableID, name, diseaseAlleleFreq, 
                              pen11, pen12, pen22, malePen1, malePen2) 
                             values (?, ?, ?, ?, ?, ?, ?, ?, ?)" ) ;
      $sth->execute(undef, $id, $$asdPtr{name}, $$asdPtr{diseaseAlleleFreq}, $$asdPtr{pen11}, $$asdPtr{pen12}, $$asdPtr{pen22}, $$asdPtr{malePen1}, $$asdPtr{malePen2}) ;
      $asdID = $sth->{'mysql_insertid'} ;
      $sth->finish() ;
      if ( defined($aseListPtr = $$asdPtr{AffStatElements}) ) {
	if (defined $oldAsdID) {
	  $dbh->do( "delete from AffectionStatusElement
                     where asDefID = $oldAsdID" ) ;
	}
	$sth = $dbh->prepare( "insert into AffectionStatusElement 
                               (asElementID, asDefID, code, type, formula) 
                               values (?, ?, ?, ?, ?)" ) ;
	foreach $asePtr (@$aseListPtr) {
	  $sth->execute(undef, $asdID, $$asePtr{code}, $$asePtr{type}, $$asePtr{formula}) ;	  
	}
	$sth->finish() ;
      }
    }
    if ( defined($lcDefPtr = $sv->field("LCDef")) ) {
      ( $oldLcdID ) = $dbh->selectrow_array( "select lcDefID from LiabilityClassDefinition 
                                            where studyVariableID = $id" ) ;
      $dbh->do( "delete from LiabilityClassDefinition 
                 where studyVariableID = $id" ) ;
      $sth = $dbh->prepare( "insert into LiabilityClassDefinition 
                             (lcDefID, studyVariableID, name) 
                             values (?, ?, ?)" ) ;
      $sth->execute(undef, $id, $$lcDefPtr{name}) ;
      $lcdID = $sth->{'mysql_insertid'} ;
      $sth->finish() ;
      if ( defined($lcListPtr = $$lcDefPtr{LiabilityClasses}) ) {
	$dbh->do( "delete from LiabilityClass 
                   where lcDefID = $oldLcdID" ) ;
	$sth = $dbh->prepare( "insert into LiabilityClass 
                               (lcID, lcDefID, code, description, pen11, 
                                pen12, pen22, malePen1, malePen2, formula) 
                               values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" ) ;
	foreach $lcPtr (@$lcListPtr) {
	  $sth->execute(undef, $lcdID, $$lcPtr{code}, $$lcPtr{description}, $$lcPtr{pen11}, $$lcPtr{pen12}, $$lcPtr{pen22}, $$lcPtr{malePen1}, $$lcPtr{malePen2}, $$lcPtr{formula}) ;
	}
	$sth->finish() ;
      }
    }
  }

  $DEBUG and carp " ->[updateStudyVariable] End." ;
  
  return(1) ;
}

=head2 updatePhenotype

  Function  : Update a Genetics::Object::Phenotype object in the database.
  Argument  : The Genetics::Object::Phenotype object to be updated.
  Returns   : 1 on success, undef otherwise.
  Scope     : Public
  Comments  : 
              
=cut

sub updatePhenotype {
  my($self, $pt) = @_ ;
  my($id, $actualType, $sth, $active, $date, $svFormat, $valueFieldName, $aaListPtr) ;
  my $dbh = $self->{dbh} ;
    
  $DEBUG and carp " ->[updatePhenotype] $pt" ;

  $id = $pt->field("id") ;
  ( $actualType ) = $dbh->selectrow_array("select objType from Object 
                                           where id = $id") ;
  if ( $actualType ne "Phenotype") {
    carp " ->[updatePhenotype] Object with ID = $id is not a Phenotype!" ;
    return(undef) ;
  }
  # Object
  $self->_updateObjAssocData($pt) ;
  # Phenotype
  if ( defined($active = $pt->field("isActive")) ) {
    $sth = $dbh->prepare( "update Phenotype 
                           set isActive = ? 
                           where ptID = ?" ) ;
    $sth->execute($active, $id) ;
    $sth->finish() ;
  }
  if ( defined($date = $pt->field("dateCollected")) ) {
    $sth = $dbh->prepare( "update Phenotype 
                           set dateCollected = ? 
                           where ptID = ?" ) ;
    if ($date eq "DELETE") {
      $sth->execute(undef, $id) ;
    } else {
      $sth->execute($date, $id) ;
    }
    $sth->finish() ;
  }
  ( $svFormat ) = $dbh->selectrow_array( "select format from StudyVariable, Phenotype 
                                          where ptID = $id 
                                          and Phenotype.svID = StudyVariable.studyVariableID" ) ;
  $valueFieldName = lc($svFormat) . "Value" ;