view release on metacpan or  search on metacpan

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

      # ...if not, create a new Allele
      $sthA->execute(undef, $markerID, $$alleleCallPtr{alleleName}, $$alleleCallPtr{alleleType}) ;
      $alleleID = $sthA->{'mysql_insertid'} ;
    }
    $sthAC->execute(undef, $id, $alleleID, $sortOrder, $$alleleCallPtr{phase}) ;
    $alleleCallID = $sthAC->{'mysql_insertid'} ;
    $sortOrder++ ;
    # AlleleCall AssayAttributes
    if ( defined ($aaListPtr = $$alleleCallPtr{AssayAttrs}) ) {
      $self->_insertAssayAttrs($aaListPtr, "AlleleCall", $alleleCallID) ;
    }
  }
  $sthA->finish() ;
  $sthAC->finish() ;

  $DEBUG and carp " ->[insertGenotype] End." ;

  return($id) ;
}

=head2 insertStudyVariable

  Function  : Insert (create) a Genetics::Object::StudyVariable object to the database.
  Argument  : A Genetics::Object::StudyVariable object.
  Returns   : The id of the inserted object.
  Scope     : Public
  Comments  : 

=cut

sub insertStudyVariable {
  my($self, $sv) = @_ ;
  my($id, $svFormat, $svCategory, $sth, $codesListPtr, $codePtr, $cdID, $asdPtr, 
     $asdID, $aseListPtr, $asePtr, $sth1, $lcDefPtr, $lcdID, $lcListPtr, $lcPtr) ;
  my $dbh = $self->{dbh} ;

  $DEBUG and carp " ->[insertStudyVariable] $sv." ;

  # Object data
  $id = $self->_insertObjectData($sv) ;
  # StudyVariable fields
  $svFormat = $sv->field("format") ;
  $svCategory = $sv->field("category") ;
  $sth = $dbh->prepare( "insert into StudyVariable 
                         (studyVariableID, category, format, isXLinked, 
                          description, numberLowerBound, numberUpperBound, 
                          dateLowerBound, dateUpperBound)
                         values (?, ?, ?, ?, ?, ?, ?, ?, ?)" ) ;
  if ( $svFormat eq "Number") {
    $sth->execute($id, $svCategory, $svFormat, $sv->field("isXLinked"), $sv->field("description"), $sv->field("lowerBound"), $sv->field("upperBound"), undef, undef) ;
  } elsif ( $svFormat eq "Date") {
    $sth->execute($id, $svCategory, $svFormat, $sv->field("isXLinked"), $sv->field("description"), undef, undef, $sv->field("lowerBound"), $sv->field("upperBound")) ;
  } else {
    $sth->execute($id, $svCategory, $svFormat, $sv->field("isXLinked"), $sv->field("description"), undef, undef, undef, undef) ;
  }
  $sth->finish() ;
  # Code data
  if ( $svFormat eq "Code" ) {
    $sth = $dbh->prepare( "insert into CodeDerivation 
                           (codeDerivationID, studyVariableID, code, 
                            description, formula) 
                           values (?, ?, ?, ?, ?)" ) ;
    if ($svCategory eq "StaticLiabilityClass") {
      $sth1 = $dbh->prepare( "insert into StaticLCPenetrance 
                              (cdID, pen11, pen12, pen22, malePen1, malePen2)
                              values (?, ?, ?, ?, ?, ?)" ) ;
    }
    $codesListPtr = $sv->field("Codes") ;
    foreach $codePtr (@$codesListPtr) {
      $sth->execute(undef, $id, $$codePtr{code}, $$codePtr{description}, undef) ;
      $cdID = $sth->{'mysql_insertid'} ;
      if ($svCategory eq "StaticLiabilityClass") {
	$sth1->execute($cdID, $$codePtr{pen11}, $$codePtr{pen12}, $$codePtr{pen22}, $$codePtr{malePen1}, $$codePtr{malePen2}) ;
      }
    }
  }
  # AffectionStatus data
  if ( $svCategory =~ /AffectionStatus$/ ) {
    $asdPtr = $sv->field("AffStatDef") ;
    $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() ;
    # AffectionStatusElement fields
    if ( defined($aseListPtr = $$asdPtr{AffStatElements}) ) {
      $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() ;
    }
    # LiabilityClass data
    # NB: these are dynamic LCs; if the SV is of category StaticLiabilityClass,
    # the penetrance values are handled with the Codes and are stored in the 
    # StaticLCPenetrance table
    if ( defined($lcDefPtr = $sv->field("LCDef")) ) {
      $sth = $dbh->prepare( "insert into LiabilityClassDefinition 
                             (lcDefID, studyVariableID, name) 
                             values (?, ?, ?)" ) ;
      $sth->execute(undef, $id, $$lcDefPtr{name}) ;
      $lcdID = $sth->{'mysql_insertid'} ;
      $sth->finish() ;
      # LiabilityClass fields
      $lcListPtr = $$lcDefPtr{LiabilityClasses} ;
      $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 " ->[insertStudyVariable] End." ;

  return($id) ;
}

=head2 insertPhenotype

  Function  : Insert (create) a Genetics::Object::Phenotype object to the database.
  Argument  : A Genetics::Object::Phenotype object.
  Returns   : The id of the inserted object.
  Scope     : Public
  Comments  : 

=cut

sub insertPhenotype {
  my($self, $pt) = @_ ;
  my($id, $sth, $subjPtr, $subjectID, $studyVarPtr, $studyVarID, $svFormat, $aaListPtr) ;
  my $dbh = $self->{dbh} ;

  $DEBUG and carp " ->[insertPhenotype] $pt." ;

  # Object data
  $id = $self->_insertObjectData($pt) ;
  # Get Subject ID
  $subjPtr = $pt->field("Subject") ;
  if ( defined($$subjPtr{id}) ) {
    $subjectID = $$subjPtr{id} ;
  } else {
    $subjectID = $self->_getIDByImportID($$subjPtr{importID}) ;
  }
  if ( ! defined $subjectID) {
    carp " ->[insertPhenotype] Can't insert Phenotype $pt. Can't find Subject.id!" ;
    return(undef) ;
  }
  # Get StudyVariable ID
  $studyVarPtr = $pt->field("StudyVariable") ;
  if ( defined($$studyVarPtr{id}) ) {
    $studyVarID = $$studyVarPtr{id} ;
  } else {
    $studyVarID = $self->_getIDByImportID($$studyVarPtr{importID}) ;
  }
  if ( ! defined $studyVarID) {
    carp " ->[insertPhenotype] Can't insert Phenotype $pt. Can't find StudyVariable.id!" ;
    return(undef) ;
  }
  # Phenotype fields
  # First, find out what the format of the value is:
  ( $svFormat ) = $dbh->selectrow_array( "select format from StudyVariable
                                          where studyVariableID = '$studyVarID'" ) ;
  $sth = $dbh->prepare( "insert into Phenotype 
                         (ptID, subjectID, svID, numberValue, codeValue, 
                          dateValue, isActive, dateCollected) 
                         values (?, ?, ?, ?, ?, ?, ?, ?)" ) ;
  if ($svFormat eq "Number") {