view release on metacpan or  search on metacpan

lib/App/SimpleScan/TestSpec.pm  view on Meta::CPAN

  # Clean up regex if needed.
  my $regex = reverse $maybe_regex;
  if ((undef, undef, $clean, undef, $flags) = 
       ($regex =~ m|^$RE{delimited}{-delim=>'/'}{-keep}([ics]*)$|mx)) {
    # Standard slash-delimited regex.
    $self->regex($clean);
    $self->delim('/');
    $self->flags($flags);
  }
  elsif (($delim, $clean, $flags) = ($regex =~ /^m(.)(.*)\1([ics]*)$/mx)) {
    # m-something-regex-something pattern.
    $self->delim($1);
    $self->regex($clean);
    $self->flags($flags);
  }
  elsif (($clean, $flags) = ($regex =~ m|^/(.*)/([ics]*)$|mx)) {
    # slash-delimited, with flags.
    $self->delim('/');
    $self->regex($clean);
    $self->metaquote(1);
    $self->flags($flags);
  }
  else {
    # random string. We'll metaquote it and put slashes around it.
    $self->delim('/');
    $self->regex($regex);
    $self->metaquote(1);
  }

  if (! defined $self->flags) {
    $self->flags(q{});
  }

  # If we got this far, it's valid.
  return 1;
}

sub _render_regex {
  my ($self) = shift;
  my $regex = $self->regex;
  my $delim = $self->delim;
  my $flags = $self->flags;
  if (!defined $flags) {
    $self->flags(q{});
    $flags = q{};
  }

  if ($self->metaquote) {
    $regex = "\\Q$regex\\E";
  }
  if ($delim ne '/') {
    $regex = "m$delim$regex$delim";
  }
  else {
    $regex = "/$regex/";
  }
  if ($flags) {
    $regex .= $flags;
  }
  if ($regex =~ /\\/mx) {
    # Have to escape backslashes.
    $regex =~ s/\\/\\\\/mxg;
  }

  return $regex;
}

sub as_tests {
  my ($self) = @_;
  my @tests;
  my $current = 0;
  my $flags = $self->flags() || q{};
  my $uri = $self->uri;

  if (defined $uri and
      defined(my $regex =   $self->regex) and                 
      defined(my $delim =   $self->delim) and               
      defined(my $comment = $self->comment)) {                  ##no critic
    if (defined($tests[$current] = $test_type{$self->kind})) {  ##no critic
       $self->test_count($self->test_count()+1);
       $tests[$current] =~ s/<uri>/$uri/mxg;
       $tests[$current] =~ s/<delim>/$delim/mxg;
       if ($self->metaquote) {
         $tests[$current] =~ s/<regex>/\Q$regex\E/mxg;
       }
       else {
         $tests[$current] =~ s/<regex>/$regex/mxg;
       }
       $tests[$current] =~ s/<flags>/$flags/mxg;
       $tests[$current] =~ s/<comment>/$comment/mx;
       my $qregex = $self->_render_regex();
       $tests[$current] =~ s/<qmregex>/$qregex/emx;
    }
  }

  # Call any plugin per_test routines.
  for my $test_code (@tests) {
    $app->stack_test($test_code);
    for my $plugin ($app->plugins) {
      next if ! $plugin->can('per_test');

      my ($added_tests, @per_test_code) = $plugin->per_test($self);
      my $method = $added_tests ? 'stack_test' : 'stack_code';
      for my $code_line (@per_test_code) {
        $app->$method($code_line);
      }
    }
  }
  return;
}

1; # Magic true value required at end of module
__END__

=head1 NAME

App::SimpleScan::TestSpec - store a test spec, and transform it into test code


=head1 VERSION