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

[Aaron J. Mackey]

Kudos, this is fantastic!

On Dec 29, 2004, at 3:38 PM, Jason Stajich wrote:

> 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");
>
> _______________________________________________
> Bioperl-guts-l mailing list
> Bioperl-guts-l at portal.open-bio.org
> http://portal.open-bio.org/mailman/listinfo/bioperl-guts-l
>
>
--
Aaron J. Mackey, Ph.D.
Dept. of Biology, Goddard 212
University of Pennsylvania       email:  amackey at pcbi.upenn.edu
415 S. University Avenue         office: 215-898-1205
Philadelphia, PA  19104-6017     fax:    215-746-6697