[Bioperl-guts-l] bioperl-live/Bio/Factory FTLocationFactory.pm, 1.15, 1.16

[Jason Stajich]

Update of /home/repository/bioperl/bioperl-live/Bio/Factory
In directory pub.open-bio.org:/tmp/cvs-serv5201/Bio/Factory

Modified Files:
	FTLocationFactory.pm 
Log Message:
yuck. lookaheads and balanced parens.  But this is a problem that has been around for a while, glad to finally fix it.  bug #1674 describes the behavior.  Couldn't previously handle nested join(join()) properly


Index: FTLocationFactory.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Factory/FTLocationFactory.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** FTLocationFactory.pm	23 Nov 2004 16:16:34 -0000	1.15
--- FTLocationFactory.pm	29 Dec 2004 20:38:42 -0000	1.16
***************
*** 124,128 ****
      my ($self,$locstr,$is_rec) = @_;
      my $loc;
! 
      # there is no place in FT-formatted location strings where whitespace 
      # carries meaning, so strip it off entirely upfront
--- 124,128 ----
      my ($self,$locstr,$is_rec) = @_;
      my $loc;
!     
      # there is no place in FT-formatted location strings where whitespace 
      # carries meaning, so strip it off entirely upfront
***************
*** 131,136 ****
      # does it contain an operator?
      if($locstr =~ /^([A-Za-z]+)\((.*)\)$/) {
  	# yes:
! 	my $op = $1;
  	my $oparg = $2;
  	if($op eq "complement") {
--- 131,137 ----
      # does it contain an operator?
      if($locstr =~ /^([A-Za-z]+)\((.*)\)$/) {
+ 
  	# yes:
! 	my $op = lc($1);	
  	my $oparg = $2;
  	if($op eq "complement") {
***************
*** 138,142 ****
  	    $loc = $self->from_string($oparg, 1);
  	    $loc->strand(-1);
! 	} elsif(($op eq "join") || ($op eq "order") || ($op eq "bond")) {
  	    # This is a split location. Split into components and parse each
  	    # one recursively, then gather into a SplitLocationI instance.
--- 139,143 ----
  	    $loc = $self->from_string($oparg, 1);
  	    $loc->strand(-1);
! 	} elsif($op eq "join" || $op eq "order" || $op eq "bond" ) {
  	    # This is a split location. Split into components and parse each
  	    # one recursively, then gather into a SplitLocationI instance.
***************
*** 146,152 ****
  	    $loc = Bio::Location::Split->new(-verbose   => $self->verbose,
  					     -splittype => $op);
! 	    foreach my $substr (split(/,/, $oparg)) {
! 		$loc->add_sub_Location($self->from_string($substr, 1));
  	    }
  	} else {
  	    $self->throw("operator \"$op\" unrecognized by parser");
--- 147,179 ----
  	    $loc = Bio::Location::Split->new(-verbose   => $self->verbose,
  					     -splittype => $op);
! 
! 	    # have to do this to capture nested joins, something like this
! 	    # join(11..21,join(100..300,complement(150..230)))
! 	    # This fixes bug #1674
! 	    my $re;
! 	    $re = qr{
!              \(
!              (?:
!                 (?> [^()]+ )    # Non-parens without backtracking
!               |
!                 (??{ $re })     # Group with matching parens
!              )*
!              \)
!             }x;
! 	    my @sections;
! 	    if( $oparg =~ s/(.*),(join|order|bond)/$2/i) {
! 		push @sections, split(/,/,$1);
! 	    }
! 	    # lets capture and remove all the sections which
! 	    # are groups
! 	    while( $oparg =~ s/(join|order|bond)$re//ig ) {
! 		push @sections, $&;
  	    }
+ 	    push @sections, split(/,/,$oparg) if length($oparg);
+ 	    # end of fix for bug #1674
+ 	    foreach my $s (@sections) {
+ 		$loc->add_sub_Location($self->from_string($s, 1));
+ 	    }
+ 	    
  	} else {
  	    $self->throw("operator \"$op\" unrecognized by parser");