a bit further along on parsing locations

cjfields · Jun 10, 2010 · 292ff47 · 292ff47
1 parent 5d68159
commit 292ff47
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 8 deletions.
diff --git a/lib/Biome/Factory/FTLocationFactory.pm b/lib/Biome/Factory/FTLocationFactory.pm
@@ -15,6 +15,16 @@ $LOCREG = qr{
             )*
             }xmso;     
 
+# make global for now, allow for abstraction later
+our $SIMPLE_CLASS = 'Biome::Segment::Simple';
+
+our $SPLIT_CLASS = 'Biome::Segment::Split';
+
+sub BUILD {
+    my ($self) = @_;
+    $self->load_modules($SIMPLE_CLASS, $SPLIT_CLASS);
+}
+
 has coordinate_policy   => (
     is          => 'ro',
     does        => 'Biome::Location::Role::CoordinatePolicy',
@@ -43,7 +53,7 @@ sub from_string {
 
         my ($beg, $mid, $end) = ($1, $2, $3);
 
-        print STDERR sprintf("BEG:%s\tMID:%s\tEND:%s\n", $beg, $mid, $end);
+        #print STDERR sprintf("BEG:%s\tMID:%s\tEND:%s\n", $beg, $mid, $end);
 
         my @sublocs = (split(q(,),$beg), $mid, split(q(,),$end));
 
@@ -53,7 +63,7 @@ sub from_string {
         SUBLOCS:
         while (@sublocs) {
             my $subloc = shift @sublocs;
-            next if !$subloc;
+            #next if !$subloc;
             my $oparg = ($subloc eq 'join'   || $subloc eq 'bond' ||
                          $subloc eq 'order'  || $subloc eq 'complement') ? $subloc : undef;
             # has operator, requires further work (recurse)
@@ -117,11 +127,19 @@ sub from_string {
     return $loc;
 }
 
+
+{
+    my @order = qw(start join end);
+
 sub _parse_location {
     my ($self, $locstr) = @_;
     my ($loc, $seqid);
-    $self->debug( "Location parse, processing $locstr\n");
+
+    return $SIMPLE_CLASS->new(location_string => $locstr);
+
+    #$self->debug( "$locstr\n");
     # 'remote' location?
+
     #if($locstr =~ m{^(\S+):(.*)$}o) {
     #    # yes; memorize remote ID and strip from location string
     #    $seqid = $1;
@@ -190,6 +208,7 @@ sub _parse_location {
     # done (hopefully)
     #return $loc;
 }
+}
 
 no Biome;
 

diff --git a/lib/Biome/Role/Segment.pm b/lib/Biome/Role/Segment.pm
@@ -244,13 +244,27 @@ sub segment_type {
     return 'UNCERTAIN';
 }
 
+my @STRING_ORDER = qw(start loc_type end);
+
 sub from_string {
     my ($self, $string) = @_;
     return unless $string;
-    if ($string =~ /^([\?<])(\d+)(?:([.^]{1,2})(\d+)([\?<]))?$/xmso) {
-        my ($start_pos, $start, $range_type, $end, $end_pos) = ($1, $2, $3, $4, $5);
-    } else {
-        $self->throw("Can't parse location string: $string");
+    my @loc_data = split(/(\.{2}|\^|\:)/, $string);
+    if (@loc_data == 5) {
+        $self->seq_id(shift @loc_data);
+        shift @loc_data;
+    }
+    for my $i (0..$#loc_data) {
+        my $order = $STRING_ORDER[$i];
+        my $str = $loc_data[$i];
+        if ($order eq 'start' || $order eq 'end') {
+            $str =~ s{[\[\]\(\)]+}{}g;
+            print STDERR "$str\n";
+
+        } else {
+            $self->start_pos_type($str);
+            $self->end_pos_type($str);
+        }
     }
 }
 

diff --git a/lib/Biome/Segment/Simple.pm b/lib/Biome/Segment/Simple.pm
@@ -12,6 +12,13 @@ sub BUILD {
     # correct for reversed location coordinates
     # (this should prob. be an exception upon instance creation, but we try to
     # DTRT for now)
+
+    if ($params->{location_string}) {
+        $self->throw("Arg!!!!") if keys(%$params) > 1;
+        $self->from_string($params->{location_string});
+        return;
+    }
+
     if ($params->{start} && $params->{end} && ($params->{end} < $params->{start})) {
         $self->warn('End is greater than start; flipping strands');
         $self->end($params->{start});

diff --git a/t/Factory/FTLocationFactory.t b/t/Factory/FTLocationFactory.t
@@ -100,8 +100,8 @@ my $locfac = Biome::Factory::FTLocationFactory->new(-verbose => 1);
 # sorting is to keep the order constant from one run to the next
 foreach my $locstr (keys %testcases) {
     #print STDERR "$locstr\n";
-	my $loc = $locfac->from_string($locstr);
     print STDERR "\n";
+	my $loc = $locfac->from_string($locstr);
 	#if($locstr eq "join(AY016290.1:108..185,AY016291.1:1546..1599)") {
 	#	$loc->seq_id("AY016295.1");
 	#}