Regexp to match RNA on request only

bioperl · Sep 10, 2012 · a5e6170 · a5e6170
1 parent 90f76a0
commit a5e6170
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 11 deletions.
diff --git a/Bio/Tools/AmpliconSearch.pm b/Bio/Tools/AmpliconSearch.pm
@@ -264,6 +264,7 @@ sub _set_primer {
    # the forward primer or 'rev' for the reverse primer.
    my ($self, $type, $primer) = @_;
    my $re;
+   my $match_rna = 1;
    if ($primer eq '') {
       $re = $type eq 'fwd' ? '^' : '$';
    } else {
@@ -276,7 +277,7 @@ sub _set_primer {
       my $seq = $primer->isa('Bio::SeqFeature::Primer') ? $primer->seq : $primer;
       $re = Bio::Tools::IUPAC->new(
          -seq => $type eq 'fwd' ? $seq : $seq->revcom,
-      )->regexp;
+      )->regexp($match_rna);
    }
    $self->{$type.'_regexp'} = $re;
    # Reset search in progress

diff --git a/Bio/Tools/IUPAC.pm b/Bio/Tools/IUPAC.pm
@@ -516,30 +516,33 @@ sub count {
            regular expression, you might want to compile it and make it case-
            insensitive:
               $re = qr/$re/i;
- Args    : none
+ Args    : 1 to match RNA: T and U characters will match interchangeably
  Return  : regular expression
 
 =cut
 
 sub regexp {
-    my ($self) = @_;
+    my ($self, $match_rna) = @_;
     my $re;
     my $seq = $self->{'_seq'}->seq;
     my %iupac = $self->iupac;
     my %iupac_amb = $self->iupac_amb;
     for my $pos (0 .. length($seq)-1) {
         my $res = substr $seq, $pos, 1;
         my $iupacs = $iupac{$res};
-        my $iupacs_amb = $iupac_amb{$res};
+        my $iupacs_amb = $iupac_amb{$res} || [];
         if (not defined $iupacs) {
             $self->throw("Primer sequence '$seq' is not a valid IUPAC sequence.".
                          " Offending character was '$res'.\n");
         }
-        if (scalar @$iupacs > 1) {
-            $re .= '[' . join('',@$iupacs,@$iupacs_amb) . ']';
-        } else {
-            $re .= $$iupacs[0];
+        my $part = join '', (@$iupacs, @$iupacs_amb);
+        if ($match_rna) {
+            $part =~ s/T/TU/i || $part =~ s/U/TU/i;
+        }
+        if (length $part > 1) {
+           $part = '['.$part.']';
         }
+        $re .= $part;
     }
     return $re;
 }

diff --git a/t/Tools/IUPAC.t b/t/Tools/IUPAC.t
@@ -7,7 +7,7 @@ BEGIN {
     use lib '.';
     use Bio::Root::Test;
 
-    test_begin(-tests => 45);
+    test_begin(-tests => 46);
 
     use_ok('Bio::Tools::IUPAC');
     use_ok('Bio::Seq');
@@ -31,9 +31,12 @@ ok my $iupac = Bio::Tools::IUPAC->new( -seq => $ambiprimaryseq );
 
 ok $iupac = Bio::Tools::IUPAC->new( -seq => $ambiseq );
 
-ok my $regexp = $iupac->regexp;
+ok my $regexp = $iupac->regexp, 'Regexp';
+is $regexp, 'A[AGR]TCGTTG[ACGTBDHKMNRSVWY]';
+
+$regexp = $iupac->regexp(1);
+is $regexp, 'A[AGR][TU]CG[TU][TU]G[ACGTUBDHKMNRSVWY]', 'Regexp';
 
-is $regexp, 'A[AGR]TCGTTG[ACGTBDHKMNRSVWY]', 'Regexp';
 
 is $iupac->count(), 8, 'Count';