view release on metacpan or  search on metacpan

lib/Bio/Regexp.pm  view on Meta::CPAN

sub compile {
  my ($self) = @_;

  return if $self->{compiled_regexp};

  $self->_arg_defaults;

  my $regexp_index = 0;
  my @regexp_fragments;

  foreach my $regexp (@{ $self->{regexps} }) {
    ## Parse

    my $ast = Bio::Regexp::AST->new($regexp, $self->{type}, $self->{arg});

    ## Compute meta data

    my ($min, $max) = $ast->compute_min_max;

    $self->{min} = $min if !defined $self->{min} || $min < $self->{min};
    $self->{max} = $max if !defined $self->{max} || $max > $self->{max};

    ## Main "sense" strand

    my $rendered = $ast->render;

    push @regexp_fragments, "$rendered(?{ $regexp_index })";
    $regexp_index++;

    my $component = { regexp => $regexp, };

    $component->{strand} = 1 if $self->{arg}->{strands} == 2;

    push @{ $self->{components} }, $component;

    ## Reverse complement strand

    if ($self->{arg}->{strands} == 2) {
      $ast->reverse_complement;
      $rendered = $ast->render;

      push @regexp_fragments, "$rendered(?{ $regexp_index })";
      $regexp_index++;

      my $component = { regexp => $regexp, strand => 2, };

      push @{ $self->{components} }, $component;
    }
  }

  my $compiled_regexp = ($self->{arg}->{strict_case} ? '' : '(?i)') .
                        '(' .
                        ($self->{arg}->{no_substr} ? '?:' : '') .
                        join('|', @regexp_fragments) .
                        ')';

  {
    use re 'eval';
    $self->{compiled_regexp} = qr{$compiled_regexp};
  }

  return $self;
}