From 1a92ce393491d4aa3abd745bd1885dee98ec9102 Mon Sep 17 00:00:00 2001
From: mueller <lam87@cornell.edu>
Date: Thu, 24 Feb 2011 16:50:06 -0500
Subject: [PATCH] adding support for range markers such as used for qtls.

---
 lib/CXGN/Marker/Location.pm   | 16 +++++++++++++---
 lib/CXGN/Marker/Modifiable.pm |  9 +++++++--
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/lib/CXGN/Marker/Location.pm b/lib/CXGN/Marker/Location.pm
index 0216f72..f74b022 100755
--- a/lib/CXGN/Marker/Location.pm
+++ b/lib/CXGN/Marker/Location.pm
@@ -168,11 +168,20 @@ sub position
 {
     my $self=shift;
     my($position)=@_;
+
+    if ($self->{position} =~ /\-/) { # if position describes a range, such as a QTL
+	print STDERR "RANGE DETECTED ($self->{position})\n";
+	($self->{position_north}, $self->{position_south}) = split "-", $self->{position};
+	$self->{position} = ($self->{position_south} - $self->{position_north})/2;
+    }
+
+    
+
     if(defined($position))
     {
         unless(CXGN::Tools::Text::is_number($position))
         {
-            croak"Position must be a floating-point number, not '$position'";
+            print STDERR "Position must be a floating-point number, not '$position'";
         }
         $self->{position}=$position;       
     }
@@ -420,8 +429,9 @@ sub store_unless_exists
         croak"No confidence set";
     }
     my $dbh=$self->{dbh};
-    my $statement='insert into sgn.marker_location (lg_id,map_version_id,position,confidence_id,subscript) values (?,?,?,?,?)';
-    my @values=($self->{lg_id},$self->{map_version_id},$self->{position},$self->{confidence_id},$self->{subscript});
+
+    my $statement='insert into sgn.marker_location (lg_id,map_version_id,position,confidence_id,subscript, position_north, position_south) values (?,?,?,?,?,?,?)';
+    my @values=($self->{lg_id},$self->{map_version_id},$self->{position},$self->{confidence_id},$self->{subscript}, $self->{position_north}, $self->{position_south});
     my $q=$dbh->prepare($statement);
     #print STDERR "$statement; (@values)\n";
     $q->execute(@values);
diff --git a/lib/CXGN/Marker/Modifiable.pm b/lib/CXGN/Marker/Modifiable.pm
index 435229b..cc9234c 100755
--- a/lib/CXGN/Marker/Modifiable.pm
+++ b/lib/CXGN/Marker/Modifiable.pm
@@ -295,7 +295,7 @@ sub add_experiment
     {
         croak"add_experiment must be called with a hash ref with key 'location' pointing to a location object, and/or key 'pcr_experiment' pointing to a pcr experiment object, and/or key 'rflp_experiment' pointing to an rflp experiment object";
     }
-    unless($protocol eq 'AFLP' or $protocol eq 'CAPS' or $protocol eq 'dCAPS' or $protocol eq 'RAPD' or $protocol eq 'SNP' or $protocol eq 'SSR' or $protocol eq 'RFLP' or $protocol eq 'PCR' or $protocol =~/DArT/i or $protocol =~ /OPA/i or $protocol =~ /Indel/i or $protocol =~ /ASPE/i or $protocol eq 'unknown')
+    unless($protocol eq 'AFLP' or $protocol eq 'CAPS' or $protocol eq 'dCAPS' or $protocol eq 'RAPD' or $protocol eq 'SNP' or $protocol eq 'SSR' or $protocol eq 'RFLP' or $protocol eq 'PCR' or $protocol =~/DArT/i or $protocol =~ /OPA/i or $protocol =~ /Indel/i or $protocol =~ /ASPE/i or $protocol eq 'unknown' or $protocol eq 'QTL')
     {
         croak"Protocol '$protocol' is invalid.";
     }
@@ -462,6 +462,7 @@ sub store_new_data
     {
         for my $experiment(@{$experiments})    
         {
+
             my($location_id,$pcr_id,$rflp_id);
             my $location=$experiment->{location};
             my $pcr=$experiment->{pcr_experiment};    
@@ -471,14 +472,17 @@ sub store_new_data
                 $location->marker_id($marker_id);
                 if(my $location_id=$location->store_unless_exists())
                 {
-                    #print"INSERTED: Location\n";
+                    print STDERR "INSERTED: Location $marker_id, $location_id\n";
                     push(@inserts,{marker_location=>$location_id});  
                 }
                 $location_id=$location->location_id() or croak"Could not get location_id from location object";
             }
             if($pcr)
             {
+		if (!$pcr->{protocol}) { $pcr->{protocol}='unknown'; }
+
                 $pcr->marker_id($marker_id);
+		print STDERR "INSERTING protocol ".$pcr->{protocol}." id: ".$pcr->{pcr_experiment_id}."\n";
                 if(my $pcr_id=$pcr->store_unless_exists())
                 {
                     #print"INSERTED: PCR\n";
@@ -499,6 +503,7 @@ sub store_new_data
 
             #store this marker_experiment entry unless it's already in the database
             my $protocol=$experiment->{protocol};
+		
             my $info=$sql->insert_unless_exists('marker_experiment',{marker_id=>$marker_id,location_id=>$location_id,pcr_experiment_id=>$pcr_id,rflp_experiment_id=>$rflp_id,protocol=>$protocol});
             if($info->{inserted})
             {
-- 
2.11.4.GIT