view release on metacpan or  search on metacpan

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

                        order by sortOrder") ;
  $sth->execute() ;
  while ($arrRef = $sth->fetchrow_arrayref()) {
    %acInit = () ;
    ($alleleName, $type) = $dbh->selectrow_array("select name, type 
                                                  from Allele 
                                                  where alleleID = $$arrRef[1]") ;
    %acInit = (alleleName => $alleleName, 
	       alleleType => $type, 
	       phase => $$arrRef[3]) ;
    push( @acList, { %acInit } ) ;
  }
  $param{AlleleCalls} = \@acList ;

  $gt = new Genetics::Genotype(%param) ;
  
  $DEBUG and carp " ->[getMiniGenotype] $gt" ;

  return($gt) ;
}

=head2 getStudyVariable

  Function  : Get (read) a Genetics::Object::StudyVariable object from the database.
  Argument  : The Object ID of the StudyVariable to be returned.
  Returns   : A Genetics::Object::StudyVariable object.
  Scope     : Public

=cut

sub getStudyVariable {
  my($self, $id) = @_ ;
  my($sv, %param, $sth, $sth1, $arrRef, $arrRef1, %init, %init1, $category, 
     $format, @codesList, @aseList, @lcList, $p11, $p12, $p22, $mp1, $mp2) ;
  my $dbh = $self->{dbh} ;
    
  $DEBUG and carp " ->[getStudyVariable] $id" ;

  $self->_getObjAssocData($id, \%param) ;

  # StudyVariable data
  $sth = $dbh->prepare("select category, format, isXLinked, description, 
                               numberLowerBound, numberUpperBound, 
                               dateLowerBound, dateUpperBound 
                        from StudyVariable 
                        where studyVariableID = $id") ;
  $sth->execute() ;
  $arrRef = $sth->fetchrow_arrayref() ;
  $category = $param{category} = $$arrRef[0] ;
  $format = $param{format} = $$arrRef[1] ;
  $param{isXLinked} = $$arrRef[2] ;
  defined $$arrRef[3] and $param{description} = $$arrRef[3] ;
  defined $$arrRef[4] and $param{lowerBound} = $$arrRef[4] ;
  defined $$arrRef[5] and $param{upperBound} = $$arrRef[5] ;
  defined $$arrRef[6] and $param{lowerBound} = $$arrRef[6] ;
  defined $$arrRef[7] and $param{upperBound} = $$arrRef[7] ;
  $sth->finish() ;
  # CodeDerivation data
  if ($format eq "Code") {
    if ($category eq "StaticLiabilityClass") {
      $sth = $dbh->prepare("select codeDerivationID, code, description, formula 
                          from CodeDerivation 
                          where studyVariableID = $id") ;
      $sth->execute() ;
      $sth1 = $dbh->prepare("select pen11, pen12, pen22, malePen1, malePen2 
                             from StaticLCPenetrance 
                             where cdID = ?") ;
      while ($arrRef = $sth->fetchrow_arrayref()) {
	%init = () ;
	$sth1->execute($$arrRef[0]) ;
	($p11, $p12, $p22, $mp1, $mp2) = $sth1->fetchrow_array() ;
	$init{code} = $$arrRef[1] ;
	$init{pen11} = $p11 ;
	$init{pen12} = $p12 ;
	$init{pen22} = $p22 ;
	defined $mp1 and $init{malePen1} = $mp1 ;
	defined $mp2 and $init{malePen2} = $mp2 ;
	defined $$arrRef[2] and $init{description} = $$arrRef[2] ;
	defined $$arrRef[3] and $init{formula} = $$arrRef[3] ;
	push(@codesList, { %init }) ;
      }
    } else {
      $sth = $dbh->prepare("select code, description, formula 
                            from CodeDerivation 
                            where studyVariableID = $id") ;
      $sth->execute() ;
      while ($arrRef = $sth->fetchrow_arrayref()) {
	%init = () ;
	$init{code} = $$arrRef[0] ;
	defined $$arrRef[1] and $init{description} = $$arrRef[1] ;
	defined $$arrRef[2] and $init{formula} = $$arrRef[2] ;
	push(@codesList, { %init }) ;
      }
    }
  }
  defined $codesList[0] and $param{Codes} = \@codesList ;
  
  if ($category =~ /AffectionStatus$/) {
    # AffectionStatus data
    $sth = $dbh->prepare("select name, diseaseAlleleFreq, pen11, pen12, 
                                 pen22, malePen1, malePen2, asDefID 
                          from AffectionStatusDefinition 
                          where studyVariableID = $id") ;
    $sth->execute() ;
    if ( defined ($arrRef = $sth->fetchrow_arrayref()) ) {
      %init = () ;
      $init{name} = $$arrRef[0] ;
      $init{diseaseAlleleFreq} = $$arrRef[1] ;
      $init{pen11} = $$arrRef[2] ;
      $init{pen12} = $$arrRef[3] ;
      $init{pen22} = $$arrRef[4] ;
      defined $$arrRef[5] and $init{malePen1} = $$arrRef[5] ;
      defined $$arrRef[6] and $init{malePen2} = $$arrRef[6] ;
      # Elements
      $sth1 = $dbh->prepare("select code, type, formula 
                             from AffectionStatusElement 
                             where asDefID = $$arrRef[7]") ;
      $sth1->execute() ;
      while ($arrRef1 = $sth1->fetchrow_arrayref()) {
	push(@aseList, {code => $$arrRef1[0],
			type => $$arrRef1[1],
			formula => $$arrRef1[2]}) ;
      }
      if (defined($aseList[0])) {
	$init{AffStatElements} = \@aseList ;
      }
      $param{AffStatDef} = { %init } ;
      # LiabilityClass data
      # This is for dynamic LCs
      $sth = $dbh->prepare("select name, lcDefID 
                            from LiabilityClassDefinition 
                            where studyVariableID = $id") ;
      $sth->execute() ;
      if ( defined($arrRef = $sth->fetchrow_arrayref()) ) {
	%init = () ;
	$init{name} = $$arrRef[0] ;
	# Classes
	$sth1 = $dbh->prepare("select code, description, pen11, pen12, pen22, 
                               malePen1, malePen2, formula 
                               from LiabilityClass 
                               where lcDefID = $$arrRef[1]") ;
	$sth1->execute() ;
	while ($arrRef1 = $sth1->fetchrow_arrayref()) {
	  %init1 = () ;
	  $init1{code} = $$arrRef1[0] ;
	  defined $$arrRef1[1] and $init1{description} = $$arrRef1[1] ;
	  $init1{pen11} = $$arrRef1[2] ;
	  $init1{pen12} = $$arrRef1[3] ;
	  $init1{pen22} = $$arrRef1[4] ;
	  defined $$arrRef1[5] and $init1{malePen1} = $$arrRef1[5] ;
	  defined $$arrRef1[6] and $init1{malePen2} = $$arrRef1[6] ;
	  $init1{formula} = $$arrRef1[7] ;
	  push(@lcList, { %init1 }) ;
	}
	$init{LiabilityClasses} = \@lcList ;
	$param{LCDef} = { %init } ;
      }
    }
  }

  $sv = new Genetics::StudyVariable(%param) ;
  
  $DEBUG and carp " ->[getStudyVariable] $sv" ;

  return($sv) ;
}

=head2 getMiniStudyVariable

  Function  : Get a "light" version of a Genetics::Object::StudyVariable object 
              from the database.
  Argument  : The Object ID of the StudyVariable to be returned.
  Returns   : A Genetics::Object::StudyVariable object.
  Scope     : Public
  Comments  : "Light" version means that the object has only the name and id 
              fields from Object, and it does not contain any associated NameAlias, 
              Contact, DBXReference or Keyword data.  It also has a sub-set of 
              StudyVariable-specific fields.
=cut

sub getMiniStudyVariable {
  my($self, $id) = @_ ;
  my($sv, %param, $sth, $sth1, $arrRef, $arrRef1, %init, %init1, $category, 
     $format, @codesList, @aseList, @lcList, $p11, $p12, $p22, $mp1, $mp2) ;
  my $dbh = $self->{dbh} ;
    
  $DEBUG and carp " ->[getMiniStudyVariable] $id" ;

  # StudyVariable data
  $sth = $dbh->prepare("select name, id, dateCreated, dateModified, comment, 
                               category, format, isXLinked, description 
                        from Object, StudyVariable 
                        where id = $id 
                        and id = studyVariableID") ;
  $sth->execute() ;
  $arrRef = $sth->fetchrow_arrayref() ;
  $sth->finish() ;
  defined $arrRef or return(undef) ;

  $param{name} = $$arrRef[0] ;
  $param{id} = $$arrRef[1] ;
  $param{dateCreated} = $$arrRef[2] ;
  $param{dateModified} = $$arrRef[3] ;
  $param{comment} = $$arrRef[4] ;
  $category = $param{category} = $$arrRef[5] ;
  $format = $param{format} = $$arrRef[6] ;
  $param{isXLinked} = $$arrRef[7] ;
  defined $$arrRef[8] and $param{description} = $$arrRef[8] ;
  # CodeDerivation data
  if ($format eq "Code") {
    if ($category eq "StaticLiabilityClass") {
      $sth = $dbh->prepare("select codeDerivationID, code, description, formula 
                          from CodeDerivation 
                          where studyVariableID = $id") ;
      $sth->execute() ;
      $sth1 = $dbh->prepare("select pen11, pen12, pen22, malePen1, malePen2 
                             from StaticLCPenetrance 
                             where cdID = ?") ;
      while ($arrRef = $sth->fetchrow_arrayref()) {
	%init = () ;
	$sth1->execute($$arrRef[0]) ;
	($p11, $p12, $p22, $mp1, $mp2) = $sth1->fetchrow_array() ;
	$init{code} = $$arrRef[1] ;
	$init{pen11} = $p11 ;
	$init{pen12} = $p12 ;
	$init{pen22} = $p22 ;
	defined $mp1 and $init{malePen1} = $mp1 ;
	defined $mp2 and $init{malePen2} = $mp2 ;
	defined $$arrRef[2] and $init{description} = $$arrRef[2] ;
	defined $$arrRef[3] and $init{formula} = $$arrRef[3] ;
	push(@codesList, { %init }) ;
      }
    } else {
      $sth = $dbh->prepare("select code, description, formula 
                            from CodeDerivation 
                            where studyVariableID = $id") ;
      $sth->execute() ;
      while ($arrRef = $sth->fetchrow_arrayref()) {
	%init = () ;
	$init{code} = $$arrRef[0] ;
	defined $$arrRef[1] and $init{description} = $$arrRef[1] ;
	defined $$arrRef[2] and $init{formula} = $$arrRef[2] ;
	push(@codesList, { %init }) ;
      }
    }
  }
  defined $codesList[0] and $param{Codes} = \@codesList ;
  
  if ($category =~ /AffectionStatus$/) {
    # AffectionStatus data
    $sth = $dbh->prepare("select name, diseaseAlleleFreq, pen11, pen12, 
                                 pen22, malePen1, malePen2, asDefID 
                          from AffectionStatusDefinition 
                          where studyVariableID = $id") ;
    $sth->execute() ;
    if ( defined ($arrRef = $sth->fetchrow_arrayref()) ) {
      %init = () ;
      $init{name} = $$arrRef[0] ;
      $init{diseaseAlleleFreq} = $$arrRef[1] ;
      $init{pen11} = $$arrRef[2] ;
      $init{pen12} = $$arrRef[3] ;
      $init{pen22} = $$arrRef[4] ;
      defined $$arrRef[5] and $init{malePen1} = $$arrRef[5] ;
      defined $$arrRef[6] and $init{malePen2} = $$arrRef[6] ;
      # Elements
      $sth1 = $dbh->prepare("select code, type, formula 
                             from AffectionStatusElement 
                             where asDefID = $$arrRef[7]") ;
      $sth1->execute() ;
      while ($arrRef1 = $sth1->fetchrow_arrayref()) {
	push(@aseList, {code => $$arrRef1[0],
			type => $$arrRef1[1],
			formula => $$arrRef1[2]}) ;
      }
      $init{AffStatElements} = \@aseList ;
      $param{AffStatDef} = { %init } ;
    }
  }

  $sv = new Genetics::StudyVariable(%param) ;
  
  $DEBUG and carp " ->[getMiniStudyVariable] $sv" ;

  return($sv) ;
}

=head2 getPhenotype

  Function  : Get (read) a Genetics::Object::Phenotype object from the database.
  Argument  : The Object ID of the Phenotype to be returned.
  Returns   : A Genetics::Object::Phenotype object.
  Scope     : Public

=cut

sub getPhenotype {
  my($self, $id) = @_ ;
  my($pt, %param, $sth, $arrRef, $sth1, $arrRef1, $subjName, $svName, 
     @aaList, $aaName, $dataType, $value) ;
  my $dbh = $self->{dbh} ;
    
  $DEBUG and carp " ->[getPhenotype] $id" ;

  $self->_getObjAssocData($id, \%param) ;

  # Phenotype data
  $sth = $dbh->prepare("select subjectID, svID, numberValue, codeValue, 
                               dateValue, isActive, dateCollected 
                        from Phenotype 
                        where ptID = $id") ;
  $sth->execute() ;
  $arrRef = $sth->fetchrow_arrayref() ;
  ( $subjName ) = $dbh->selectrow_array("select name from Object 
                                         where id = $$arrRef[0]") ;
  $param{Subject} = {name => $subjName, id => $$arrRef[0]} ;
  ( $svName ) = $dbh->selectrow_array("select name from Object 
                                       where id = $$arrRef[1]") ;
  $param{StudyVariable} = {name => $svName, id => $$arrRef[1]} ;
  $value = $$arrRef[2] || $$arrRef[3] || $$arrRef[4] ;
  $param{value} = $value || 0 ; # the 'or 0' here is for cases where the number 
                                # or code value is 0, in which case the above 
                                # statement sets value to false.  I think this 
                                # is ok, since there has to be a value.
  $param{isActive} = $$arrRef[5] ;
  defined $$arrRef[6] and $param{dateCollected} = $$arrRef[6] ;
  $sth->finish() ;
  # Phenotype AssayAttrs
  $sth = $dbh->prepare("select objID, attrID, stringValue, numberValue, 
                               dateValue, booleanValue
                        from AttributeValue 
                        where objID = $id") ;
  $sth->execute() ;
  while ($arrRef = $sth->fetchrow_arrayref()) {